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

78

    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. Elina Valtosella täydellinen mahalasku Ylen Ykkösaamussa. Ei hallitse alkuunkaan tonttiaan.

      Ulkoministerimme Elina Valtosen haastattelu Ylen Ykkösaamussa 25.1.2025 oli jotain niin kiusallista katsottavaa, ettei
      Maailman menoa
      365
      1763
    2. Huomaatko että

      Olen kiinnostunut seksielämästäsi. Mitä uskot sen taustalla olevan?
      Ikävä
      145
      1256
    3. Kelpaisinko vielä?

      Huolisitko minut vielä vaikka olen ollut sen toisen kanssa?
      Ikävä
      78
      903
    4. Kerro yksi positiivinen kokemus kaivatusta

      Voi tunnistaa. Jos ei ole positiivista, voi kertoa negatiivisen. Ne ehkä jää mieleen paremmin.
      Ikävä
      35
      836
    5. Olen niin pettynyt itseeni

      Että sait väärän kuvan minusta ja luulit etten ole kiinnostunut ja menit eteenpäin. Miten nyt käy jos vielä haluamme toi
      Ikävä
      39
      815
    6. Nainen, haluatko olla haluttava

      Miettinyt tässä salaisuutta sun vetovoimallesi. Kaunis? Kyllä. Kiinnostava luonne? Kyllä. Hyvä kroppa? On. Harrastukset,
      Ikävä
      44
      801
    7. Ei ole yhtään

      Helppoa olla sinuun rakastunut
      Ikävä
      101
      795
    8. Luottoluokitus-raportti Tekijä ja Duunari Oy

      "Arvotus ja luottoraja: Yrityksen pisteet: 0.00 / 100 Taloustutka-tähdet: Suositeltu luottoraja: 0 €" "Luotonantoa suos
      Imatra
      67
      686
    9. Oot hauska

      Oot hauska ja kiva nainen.
      Ikävä
      50
      678
    10. Miksi itkit silloin

      Perääni et sydämesi särkyy jos lähden. Sitten päätit särkeä minun sydämeni olemalla toisen kanssa. Tuottamalla sitä tusk
      Ikävä
      4
      664
    Aihe