Poradenství a kurzy
Perete se s Excelem? Zbavte sešity špíny a vyždímejte z Excelu maximum! Aviváž zdarma :-)
Algoritmy
Plné využití vzorců a nástrojů listu, aplikovaná matematika, VBA, netradiční řešení úloh, optimalizace běhu aplikací...
Programování
VBA a VB.NET, komentovaný a zarovnaný kód, ADO, WSH, WMI, API...
Štábní kultura
Čisté tabulky, infografika, uživatelsky přívětivé prostředí

Univerzální ComboBox

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.

Univerzální ComboBox

Univerzální ComboBox

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í:

Univerzální ComboBox - Properties

Univerzální ComboBox – Properties

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:

'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:

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):

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

LinkedIn Auto Publish Powered By : XYZScripts.com