Již dříve jsem zmínil vizi jediného „supercomba“ na listu, jehož obsah (seznam položek čerpaný z listu databanky) se mění v závislosti na sloupci, pro který má v danou chvíli sloužit. V tomto článku představím převážně funkční návrh.
Samozřejmě se neobejdeme bez maker VBA. Původní řešení jsem měl postavené na ovládacím prvku Formuláře, předělávka již využívá ovládací prvek ActiveX (ComboBox). Obě varianty mají své pro i proti, nicméně v prvku ActiveX lze kupříkladu nastavit velikost písma a alespoň částečně ovlivnit grafickou podobu. Poté, co si ComboBox vybereme na kartě Vývojář (pokud ji nevidíte, musíte ji přidat přes Soubor / Možnosti), nastavíme v Režimu návrhu požadované vlastnosti prvku (tlačítko Vlastnosti zobrazí dialog Properties). Teoreticky lze v seznamu ComboBoxu i vyhledávat, bohužel v kombinaci s užitou událostí klepnutí na prvek (Click) to v praxi nelze dost dobře realizovat. Zde je moje nastavení:
Asi nejužitečnější je změna vlastnosti Style na fmStyleDropDownList. Prvek tak nebude umožňovat editaci textového pole nad seznamem. Škoda, že vlastnost ShowDropButtonWhen (skrytí tlačítka vpravo v textovém poli) Excel ignoruje. Následně doplníme procedury uvedené níže do modulu listu, kde je ComboBox aplikován a vypneme Režim návrhu.
Deklarační část modulu listu:
1 2 3 4 5 | 'zdroj dat Private Const cstrDatabanka = "Databanka" 'cíl Private Const cstrOblastPouziti As String = "B3:D22" |
Událostní procedura listu reagující na změnu výběru buněk:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rngOblastPouziti As Range Dim rngVybranaOblast As Range Dim rngBunkaZobrazeni As Range Dim rngDataPrvniBunka As Range 'je zapnutý režim kopírování? If Application.CutCopyMode = xlCopy Then Exit Sub End If 'oblast použití Set rngOblastPouziti = Range(cstrOblastPouziti) 'kontrola výběru buněk (jednosloupcový výběr v oblasti použití) If Union(rngOblastPouziti, Target).Address = rngOblastPouziti.Address And _ Target.Columns.Count = 1 Then 'přiřazení vybrané oblasti do objektové proměnné Set rngVybranaOblast = Target.Areas(Target.Areas.Count) 's vybranou oblastí... With rngVybranaOblast 'umístění ovládacího prvku určuje buňka napravo 'od poslední přidané buňky ve výběru If ActiveCell.Address = .Cells(1).Address Then Set rngBunkaZobrazeni = .Cells(.Cells.Count)(1, 2) Else Set rngBunkaZobrazeni = .Cells(1)(1, 2) End If End With 's ovládacím prvkem... With Me.cboUniversal 'odstranění stávajících položek .Clear 'vyhledání buňky s první odpovídající položkou v databance Set rngDataPrvniBunka = _ Worksheets(cstrDatabanka).Range("1:1").Find( _ Cells(rngOblastPouziti.Offset(-1, _ 0).Row, ActiveCell.Column)).Offset(1, 0) 'naplnění ovládacího prvku položkami .List = Worksheets(cstrDatabanka).Range(rngDataPrvniBunka, _ rngDataPrvniBunka.End(xlDown)).Value 'umístění prvku (vpravo od poslední buňky výběru) .Top = rngBunkaZobrazeni.Top .Left = rngBunkaZobrazeni.Left End With 'zobrazení ovládacího prvku Me.cboUniversal.Visible = True Else 'skrytí ovládacího prvku Me.cboUniversal.Visible = False End If End Sub |
Událost SelectionChange má jednu nevýhodu. Jestliže chcete připojenou akci realizovat na stejné oblasti, musíte doslova použít Cimrmanův „krok stranou“ a vrátit se zpět.
Událostní procedura klepnutí na ovládací prvek (rovněž modul listu):
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | Private Sub cboUniversal_Click() Dim rngBunka As Range Dim ref With cboUniversal 'pro neprázdný výběr buněk If (Selection.Cells.Count > 1) And (WorksheetFunction.CountA(Selection) _ > 0) Then 'dotaz na přepsání ref = MsgBox("Přepsat neprázdné buňky ve výběru (nelze vzít zpět)?", _ vbExclamation + vbYesNo + vbDefaultButton2) Select Case ref 'ano, přepsat stávající Case vbYes Selection.Cells = .List(.ListIndex) 'ne, ponechat stávající Case vbNo On Error Resume Next For Each rngBunka In Selection 'naplnit jen prázdné buňky If IsEmpty(rngBunka) Then rngBunka = .List(.ListIndex) Next rngBunka On Error GoTo 0 End Select Else 'naplnění prázdných buněk Selection.Cells = .List(.ListIndex) End If 'skrytí ovládacího prvku .Visible = False End With End Sub |
Řešení není nijak zvlášť „uhlazené“. Jednoduše musíme přetrpět některé nedodělky ovládacích prvků ActiveX a vystačit si s tím, co máme k dispozici. Jistě, nabízí se i varianta vlastního panelu s výběrovými seznamy, ať už zpracovaného přímo v Pásu karet, na vlastním Panelu nástrojů pod kartou Doplňky a nebo na formuláři UserForm. Ve větším měřítku, kdy je zdrojem databáze, stojí za to spustit Visual Studio (Community zdarma) a směřovat řešení i třeba do Podokna úloh.
Příloha:
univerzalni_combobox.zip