Sama lista useisiin ComboBoxeihin VBA:lla?

Excelsson

Taul1:ssä esim. 20 ComboBoxia. Kuinka saadaan kaikkiin compoihin sama lista lyhyemmällä koodilla, ettei tarvi jokaista compoa erikseen määritellä samoilla listakohteilla? (Alla esimerkki). For...Next?

With Taul1.ComboBox1
.AddItem ("Yksi")
.AddItem ("Kaksi")
....jne....
End With

With Taul1.ComboBox2
.AddItem ("Yksi")
.AddItem ("Kaksi")
....jne.......

Kiitos!

4

112

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • vaihda taulukon nimi sopivaksi ja luetteloalue nyt A1:AXXXXXX
      Option Explicit
      Sub Täytä()
      Dim OLEobj As Object
      Dim Lista As Variant
      Lista = Sheets("Sheet1").Range("A1", Sheets("Sheet1").Range("A65536").End(xlUp))
      For Each OLEobj In ActiveSheet.OLEObjects
      If TypeName(OLEobj.Object) = "ComboBox" Then
      OLEobj.Object.List = Lista
      End If
      Next OLEobj
      End Sub

      Keep EXCELing
      @Kunde

    • Excelsson

      Kiitos paljon!

      Sain toimimaan seuraavalla muutoksella. Compokohteet sijaitsevat B50:B60.

      Lista = Sheets("Sheet1").Range("B50:B60")

      Alkuperäinen pätkä:
      Lista = Sheets("Sheet1").Range("B50", Sheets("Sheet1").Range("B60").End(xlUp))

      ..listaa vain rivit B49:B50, eli yhtä riviä liian ylhäältä ja vain kaksi kohdetta.
      Käytössäni on Excel 2003 versio, olisiko sillä vaikutusta asiaan?

      Tietysti nyt kaikkissa taulukon kompoissa on sama lista ja taulukossa on kaksi muuta compolistaa, mutta ne määritellään nyt erikseen käyttäen ensin .Clear toimintoa :)

      Pistän haastetta :) Kuinka määritellään sitten useampi comporyhmä eri listoilla? Eli compot 1-10 Lista1, compot 11-20 Lista2, compot 21-30 Lista3 jne...

      • Alkuperäinen pätkä:
        Lista = Sheets("Sheet1").Range("B50", Sheets("Sheet1").Range("B60").End(xlUp))

        ..listaa vain rivit B49:B50, eli yhtä riviä liian ylhäältä ja vain kaksi kohdetta.
        Käytössäni on Excel 2003 versio, olisiko sillä vaikutusta asiaan?

        EI
        Sheets("Sheet1").Range("B60").End(xlUp)
        ko. koodin pätkä valitsee solun B49 eli sinulla on solussa B49 joku arvo jolloin valinnaksi tulee koodissa Lista = Sheets("Sheet1").Range("B50", Sheets("Sheet1").Range("B60").End(xlUp)) B50:B49...

        eli muutat sitä arvoa B61 tai tarpeeksi kauaksi. Tietenkin jos sulla listat allekkain silloin ainut keino on hard codeta ne tyyliin Lista = Sheets("Sheet1").Range("B50:B60") kuten olet tehnyt


        no haasteeseen sitten...
        ei siinä tartte kummosta lisäystä

        Option Explicit
        Sub Täytä()
        Dim OLEobj As Object
        Dim Lista1 As Variant
        Dim Lista2 As Variant
        Dim Lista3 As Variant
        Lista1 = Sheets("Sheet1").Range("B50", Sheets("Sheet1").Range("B600").End(xlUp))
        Lista2 = Sheets("Sheet1").Range("C50", Sheets("Sheet1").Range("C600").End(xlUp))
        Lista3 = Sheets("Sheet1").Range("D50", Sheets("Sheet1").Range("D600").End(xlUp))
        For Each OLEobj In ActiveSheet.OLEObjects
        If TypeName(OLEobj.Object) = "ComboBox" Then
        Select Case Mid(OLEobj.Name, 9)
        Case 1 To 10
        OLEobj.Object.List = Lista1
        Case 11 To 20
        OLEobj.Object.List = Lista2
        Case 21 To 30
        OLEobj.Object.List = Lista3
        End Select
        End If
        Next OLEobj
        End Sub


        keep EXCELing
        @Kunde


    • Excelsson

      Kolahti :)

      Kiitos!

    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Vihamielisyys naisia kohtaan on jo yllättävän suuri ongelma

      Esiintyy laajemmassa mittakaavassa, mitä vain tällä palstalla. Mistä tuo ilmiö nyt oikein johtuu, ja saa alkuvoimansa?
      Sinkut
      557
      2510
    2. Odotan sitä hetkeä

      kun nähdään taas. Tiedän, että sinäkin odotat. Kun se päivä koittaa, katseesi hakee minua. Ehkä arkailemme toisiamme väh
      Ikävä
      67
      1416
    3. Olen melko vakuuttunut

      etten tule olemaan koskaan täysin onnellinen ilman sinua. En uskonut, että näin kävisi kenenkään kanssa. Kunnes sain kok
      Ikävä
      83
      1340
    4. Muistatko kaivattusi

      Syntymäpäivän? Päivämäärä riittää. 🌹
      Ikävä
      97
      1297
    5. Leijonat Maailmanmestareita!

      Ihanaa Leijonat, ihanaa!!!
      Maailman menoa
      137
      1228
    6. Minkälaisessa asennossa

      Haluaisit kaivattusi kanssa olla?
      Ikävä
      105
      1118
    7. Postimerkki kirjeeseen ja kortiin maksaa jo 3 euroa!

      https://yle.fi/a/74-20229241 Kyllä tämä on järjetön hinta, Posti tuhoaa itsensä tällä hinnalla, täytyyhän Postin "Herro
      Maailman menoa
      133
      994
    8. Sinä siellä lähistöllä

      Tahtoisin tutustua paremmin 💫
      Ikävä
      48
      910
    9. Mulla on ikävä

      sua nainen ja niitä katseita ❤️ Lupaatko, että katseemme kohtaa taas?
      Ikävä
      47
      851
    10. Sitä saattaa vähän hölmöillä

      rakkauspäissään, jos tunteita on enemmän kuin osaa käsitellä. Alkuhölmöilyt on söpöä ja sallittavaa.
      Ikävä
      60
      790
    Aihe