Kontrolka typu ListBox służy nam do wyboru jednej lub wielu wartości spośród długiej listy wpisów. Pracując na formularzu, często niejako wymuszamy na użytkowniku zaznaczenie przynajmniej jednej wartości. Co ciekawe, kompilator VBA odróżnia brak działania od zaznaczenia i późniejszego oznaczenia tej samej pozycji. Artykuł raczej dla osób zaawansowanych w VBA.
Lista miesięcy i dni tygodnia
Na formularzu mamy dwie kontrolki typu ListBox. Pierwsza z nich wyświetla nazwy dni tygodnia (od poniedziałku do niedzieli), natomiast druga – nazwy miesięcy (od stycznia do grudnia).
W obu przypadkach zezwalamy użytkownikowi na wybór wielu wpisów, natomiast konieczne jest, aby użytkownik zaznaczył przynajmniej jedną wartość z każdej listy – tylko wtedy możemy w naszym kodzie przejść dalej.
Kod w module formularza
Kod w module UserForm jest długi i wygląda następująco.
|
1 2 3 4 5 |
'Żródła danych dla list rozwijanych Private m_avListaDniTygodnia(1 To 7) As Variant Private m_avListaMiesiecy(1 To 12) As Variant |
|
1 2 3 4 5 6 7 8 |
'Wybrane wartości na liście Private m_avWybraneDniTygodnia As Variant Private m_avWybraneMiesiace As Variant Property Get WybraneDniTygodnia() As Variant: WybraneDniTygodnia = m_avWybraneDniTygodnia: End Property Property Get WybraneMiesiace() As Variant: WybraneMiesiace = m_avWybraneMiesiace: End Property |
|
1 2 3 4 5 |
'Przycisk OK lub Anuluj Private m_bOK As Boolean Property Get OK() As Boolean: OK = m_bOK: End Property |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
Private Sub UserForm_Initialize() Dim x As Integer 'Załaduj do tablic listę dni tyg. i miesięcy 1 For x = 1 To 12 2 m_avListaMiesiecy(x) = MonthName(x, False) 3 If x <= 7 Then 4 m_avListaDniTygodnia(x) = WeekdayName(x, False, vbMonday) 5 End If 6 Next x 'Załaduj tablice jako źródła dla list rozwijanych 7 Me.lstDniTygodnia.List = m_avListaDniTygodnia 8 Me.lstMiesiace.List = m_avListaMiesiecy End Sub |
|
1 2 3 4 5 |
Private Sub lstDniTygodnia_Change() m_avWybraneDniTygodnia = avWybraneWpisy(Me.lstDniTygodnia) End Sub |
|
1 2 3 4 5 |
Private Sub lstMiesiace_Change() m_avWybraneMiesiace = avWybraneWpisy(Me.lstMiesiace) End Sub |
|
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 |
Private Function avWybraneWpisy(ByRef ListBox As MSForms.ListBox) As Variant Dim avTemp() As Variant ' Tablica tymczasowa (nie znamy jej wymiaru) Dim x As Integer, r As Integer ' Liczniki pętli 'Przejdź w pętli po wszystkich elementach listy rozwijanej 1 For x = 0 To ListBox.ListCount - 1 'Dodaj do tablicy zaznaczone elementy 2 If ListBox.Selected(x) = True Then 'Zwiększ licznik 3 r = r + 1 'Zaczytaj wartość do tablicy 4 ReDim Preserve avTemp(1 To r) 5 avTemp(r) = ListBox.List(x) 6 End If '// If ListBox.Selected(x) = True Then 7 Next x '// For x = 0 To ListBox.ListCount - 1 'Zaczytaj wartość zmiennej do wyniku funkcji 8 avWybraneWpisy = avTemp End Function |
|
1 2 3 4 5 6 7 |
' Obsługa przycisku OK. Private Sub cmdOK_Click() 1 m_bOK = True 2 Me.Hide End Sub |
|
1 2 3 4 5 6 7 |
' Obsługa przycisku Anuluj. Private Sub cmdAnuluj_Click() 1 m_bOK = False 2 Me.Hide End Sub |
|
1 2 3 4 5 6 7 8 9 10 |
' Powoduje, że znak [x] zachowuje się tak samo, jak przycisk Anuluj. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 1 If CloseMode = vbFormControlMenu Then 2 m_bOK = False 3 Me.Hide 4 Cancel = True 5 End If End Sub |
Problem braku wyboru
Tradycyjnie formularz traktuję jak obiekt, więc WybraneDniTygodnia i WybraneMiesiace są właściwościami publicznymi obiektu UTest. Obie właściwości powinny zwracać w wyniku tablice typu Variant. Właściwość OK, informuje mnie z kolei czy użytkownik kliknął przycisk OK czy Anuluj.
W teorii wszystko wydaje się bardzo proste gdy użytkownik wybierze coś na każdej z list.
Załóżmy jednak taką sytuację, że użytkownik pierwszą listę lstDniTygodnia zostawia w spokoju, natomiast na drugiej klika w styczeń, ale po chwili odznacza go. Na końcu użytkownik klika w przycisk OK.
I teraz najciekawsze. Pomimo tego, że w obu przypadkach użytkownik niczego nie wybrał, VBA traktuje te zachowania jako odmienne, co pokazuje screen poniżej.
W pierwszym przypadku avMojeDniTyg nie jest tablicą! Łatwo się o tym przekonać wywołując w okienku Immediate funkcję VB IsArray – zwróci ona False.
W drugim przypadku zaś mamy tablicę, dla avMojeMiesiace IsArray zwróci True.
To nie koniec ciekawostek… Pomimo tego, że jest to tablica, to próba sprawdzenia czy coś w tej tablicy jest (za pomocą Ubound lub WorksheetFunction.CountA) generuje błąd – odpowiednio nr 9 i 5. Tak jakby ta avMojeMiesiace nie była tablicą, a przecież jest….
Jak sprawdzić czy użytkownik coś wybrał?
Możemy to zrobić np. w ten sposób. Najpierw sprawdzamy czy funkcja IsArray zwraca w wyniku True. Jeżeli nie, już wiem, że użytkownik niczego nie wybrał. Nawet przy wyborze jednego elementu – IsArray zwróci True.
Jeżeli natomiast zwraca True, to sprawdzam jeszcze jeden warunek – właśnie za pomocą funkcji WorksheetFunction.CountA czyli ILE.NIEPUSTYCH sprawdzam czy coś w tej tablicy jest.
Ale wcześniej oczywiście nakazuję ignorować przez chwilę błędy. Jeżeli coś w tej tablicy jest, to funkcja zwróci mi w wyniku wartość różną od zera (i nie wygeneruje błędu) – w przeciwnym razie funkcja zwróci wartość 0 i wygeneruje błąd (ale zostanie on zignorowany, więc kod się „nie wysypie”).
Funkcja bCzySaDane pozwala mi właśnie określić czy użytkownik wybrał coś na formularzu i to jest kluczowe z punktu widzenia dalszego działania programu.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
Function bCzySaDane(ByRef avDane As Variant) As Boolean Dim lNiepuste As Long 1 If IsArray(avDane) Then 2 On Error Resume Next 3 lNiepuste = WorksheetFunction.CountA(avDane) 4 On Error GoTo 0 5 If lNiepuste <> 0 Then 6 bCzySaDane = True 7 End If 8 End If End Function |
Kod wywołujący formularz
Poniższy kod znajduje się w module zwykłym. Wywołujemy w nim formularz.
|
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 |
Private Const ms_MODUL As String = "MModulGlowny" Option Explicit Public Sub ZaczytajDane() Dim frmTest As UTest ' Egzemplarz obiektu UTest Dim avMojeDniTyg As Variant ' Wybrane na formie dni tyg. Dim avMojeMiesiace As Variant ' Wybrane na formie miesiące Dim bCzyOk As Boolean ' Czy user kliknął OK czy Anuluj Const sPROC As String = "ZaczytajDane" 'Aktywuj obsługę błędów na starcie 1 On Error GoTo ObslugaBledu 'Utwórz egzemplarz obiektu UTest 2 Set frmTest = New UTest 'Wyświetl formę 3 frmTest.Show vbModal 'Zaczytaj do zmiennych 4 With frmTest 5 bCzyOk = .OK 6 avMojeDniTyg = .WybraneDniTygodnia 7 avMojeMiesiace = .WybraneMiesiace 8 End With 'Wyloguj formę 9 Unload frmTest 'Działaj gdy user kliknął OK i gdy tablice nie są puste 10 If bCzyOk Then 11 If bCzySaDane(avMojeDniTyg) Then 12 If bCzySaDane(avMojeMiesiace) Then 13 MsgBox "Jest OK! - można działać dalej... " 14 End If 15 End If 16 End If '// If bCzyOk Then Wyjscie: 17 Set frmTest = Nothing 18 On Error GoTo 0 19 Exit Sub ObslugaBledu: 20 Application.ScreenUpdating = True 21 MsgBox Title:="Błąd programu!", Buttons:=vbInformation, _ Prompt:="Informacje dotyczące błędu: " & vbCr & vbCr & _ "Numer: " & vbTab & Err.Number & vbCr & _ "Opis: " & vbTab & Err.Description & vbCr & vbCr & _ "Moduł: " & vbTab & ms_MODUL & vbCr & _ "Makro: " & vbTab & sPROC & vbCr & _ "Linia: " & vbTab & Erl() 23 GoTo Wyjscie End Sub |
Plik XLSM
