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!
Sama lista useisiin ComboBoxeihin VBA:lla?
4
87
Vastaukset
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
- 1026738
Nikkalassa vauhdilla nokka kohti taivasta
Mitähän Darwin sanoisi näistä 4 suomalaisesta, jotka kävivät Haparandan puolella näyttämässä, kuinka Suomi auto kulkee t324038törniöläiset kaaharit haaparannassa
isäpapan autolla kaahatta 270 km/h metsään https://www.lapinkansa.fi/nsd-kaksi-suomalaista-kuoli-kolarissa-haaparannall/303465Sitä saa mitä tilaa Perussuomalaiset!
https://yle.fi/a/74-20160212 SDP:n kannatus se vain nousee ja Keskusta on kolmantena. Kokoomus saanut pienen osan persu3871853- 331428
- 321389
Eelin, 20, itsemurhakirje - Suomalaisen terveydenhuollon virhe maksoi nuoren elämän
Yksikin mielenterveysongelmien takia menetetty nuori on liikaa. Masennusta sairastava Eeli Syrjälä, 20, ehti asua ensi491169Anteeksi kulta
En oo jaksanut pahemmin kirjoitella, kun oo ollut tosi väsynyt. Mut ikävä on mieletön ja haluisin kuiskata korvaasi, hyv111016Perttu Sirviö laukoo täydestä tuutista - Farmi Suomi -kisaajista kovaa tekstiä "Pari mätää munaa..."
Ohhoh, Farmilla tunteet alkaa käydä kuumana, kun julkkiksia tippuu jaksosta toiseen! Varo sisältöpaljastuksia: https:11960- 42909