Lista rozwijana jest łatwa do utworzenia z poziomu Excela. Służy do tego mechanizm sprawdzania poprawności (walidacji danych). Za pomocą formularza UserForm możemy stworzyć dużo bardziej rozbudowane i eleganckie rozwiązanie, które pozwala dodatkowo filtrować tą listę – również z uwzględnieniem wielkości liter.
Idea zadania
W kolumnie A arkusza Kraje znajduje się spis wszystkich krajów europejskich. Chcemy, aby ta lista była źródłem danych dla kontrolki Listbox na formularzu.
Po wyborze na liście odpowiedniego kraju i kliknięciu OK, jego nazwa powinna się zapisywać w kolumnie C.
Dodatkowo, będziemy stosować dwa filtry:
a) tekstowy – bazujący na danej frazie
b) opcjonalny – uwzględniający wielkość liter
Budowa formularza
Formularz UKraj składa się z następujących kontrolek:
- lstKraje – lista wszystkich krajów europejskich
- txtFiltr – pole filtra (zmiana wpisu aktualizuje listę krajów na lstKraje)
- optNie – przycisk opcji Nie (gdy zaznaczony, filtr nie uwzględnia wielkości liter)
- optTak – przycisk opcji Tak (gdy zaznaczony, filtr uwzględnia wielkość liter)
- cmdAnuluj – przycisk ukrywający formularz
- cmdDodaj – przycisk dodający wybrany kraj w lstKraje do kolumny C arkusza
- fraLitery – ramka, która pełni funkcję estetyczno-grupującą. Zawiera dwa przyciski opcji (optNie + optTak)
Przyciski opcji (tzw. RadioButtony) działają inaczej od pól wyboru. Pozwalają wybrać tylko jedną z możliwych opcji (np. Kobieta, Mężczyzna). Pola wyboru pozwalają natomiast zaznaczyć wiele pozycji (np. Śniadanie, Obiad, Kolacja).
Schemat działania formularza
To co chcemy osiągnąć możemy zawrzeć w kilku punktach:
- Przy starcie formularza, do kontrolki lstKraje powinna zostać wgrana lista wszystkich krajów europejskich z kolumny A arkusza Kraje. Będzie to nasza lista rozwijana.
- Domyślnie nie chcemy rozróżniać wielkości liter.
- Jakakolwiek zmiana wpisu w polu filtrującym txtFiltr powinna od razu aktualizować listę krajów w lstKraje.
- Analogicznie, zmiana wyboru przycisku opcji (z optNie na optTak lub odwrotnie) powinna również skutkować nową listą krajów w lstKraje.
- Kliknięcie w przycisk Dodaj powinno dodać kraj (jeśli jest wybrany!) z lstKraje do kolumny C arkusza Kraje.
- Kliknięcie w przycisk Anuluj powinno ukryć formularz (a nie zamykać!). Dzięki temu w pamięci formularza zachowają się jego ustawienia.
Działanie formularza w praktyce
Kod źródłowy
Sporo kodu znajduje się w module formularza. Oprócz tego mamy dodatkowe makro zawarte w zwykłym module. Pobiera ono informacje z formularza i wczytuje nazwę kraju do kolumny C arkusza Kraje.
Moduł formularza
Zmienne prywatne poziomu modułu
Na samej górze, poza instrukcją Option Explicit, mamy zadeklarowanych kilka zmiennych prywatnych.
|
1 2 3 4 5 6 7 8 9 10 11 |
Private Const ms_MODUL As String = "UKraj" Option Explicit Private mbOK As Boolean 'Czy user kliknął OK? Private miTrybPor As Integer 'Czy uwzględniamy wielkość liter? Private mavKrajeBaza As Variant 'Lista krajów z wksKraje Private mavKrajeFiltr As Variant 'Wyfiltrowana lista krajów -> lstKraje Private msKrajWybor As String 'Wybrany kraj na lstKraje |
Rolą tych zmiennych jest przechwycenie informacji podanych przez użytkownika. Chodzi o to, że gdy użytkownik wykona jakąś akcję (np. wybierze kraj z listy, wpisze frazę do pola filtru), to chcemy taką informację przechować i mieć do niej szybki dostęp.
Przykładowo, zmienna mbOK informuje nas czy user kliknął Anuluj (mbOK przyjmie wartość FALSE), czy też przycisk Dodaj (mbOK przyjmie wartość TRUE).
Właściwości publiczne
Następnie z tych zmiennych prywatnych tworzone są właściwości publiczne obiektu. Chodzi o to, że formularz traktujemy jak klasę/obiekt. Oznacza to, że możemy mu przypisać nowe właściwości, które będą widoczne poza modułem formularza.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
Property Get OK() As String: OK = mbOK: End Property 'vbBinaryCompare 0 - Porównanie binarne. Uwzględnia wielkość znaków. 'vbTextCompare 1 - Porównanie tekstowe. Nie uwzględnia wielkości znaków Property Get TrybPorownania() As String TrybPorownania = miTrybPor End Property Property Get KrajeBaza() As Variant: KrajeBaza = mavKrajeBaza: End Property Property Get KrajeFiltr() As Variant: KrajeFiltr = mavKrajeFiltr: End Property Property Get KrajWybor() As Variant: KrajWybor = msKrajWybor: End Property |
Będziemy z tego korzystać później. W zwykłym module do zmiennej bCzyOk będziemy pobierać wartość właściwości OK. Czyli będzie to zapis bCzyOk = UKraj.OK
Będziemy także chcieli pobrać do zmiennej nazwę wybranego na liście kraju. Skorzystamy z zapisu sWybranyKraj = UKraj.KrajWybor
Userform jest specjalnym typem klasy, więc powinniśmy traktować go w ten sposób. W kodzie powinniśmy odwoływać się do jego publicznych właściwości.
Inicjalizacja formularza
W momencie startu formularza, do kontrolki lstKraje powinna nam się załadować lista rozwijana państw z kolumny A arkusza Kraje.
Oprócz tego zaznaczamy przycisk optNie ponieważ domyślnie nie chcemy rozróżniać wielkości liter.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
Private Sub UserForm_Initialize() Dim lOstArkusz As Long 'Ost. wiersz w kol. A wksKraje 'Sprawdź ost. wiersz w kol. A 1 lOstArkusz = lOstatni(wksKraje.Range("A:A")) 'Zaczytaj do zmiennej mavKrajeBaza tablicę krajów 'Wczytaj ją jako źródło dla txtKraje 2 mavKrajeBaza = WorksheetFunction.Transpose( _ wksKraje.Range("A2").Resize(lOstArkusz - 1, 1)) 'Źródło 3 Me.lstKraje.List = mavKrajeBaza 'Domyślnie nie uwzględniaj wielkości liter 4 Me.optNie.Value = True End Sub |
Funkcja filtrująca
Aby cały mechanizm działał, potrzebna jest mi uniwersalna funkcja filtrująca.
Taka funkcja powinna przefiltrować mi całą listę krajów na względu na wpisaną frazę. Powinna także uwzględnić wielkość liter, jeśli sobie tego zażyczyliśmy.
W wyniku funkcja powinna zwrócić tablicę krajów, które spełniają warunki filtrowania.
|
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 |
Private Function NowaListaKrajow(ByVal sFiltr As String) As Variant Dim avTemp() As Variant ' Tablica tymczasowa Dim sKraj As String ' Nazwa kraju Dim x As Integer, r As Integer ' Liczniki pętli 'vbBinaryCompare 0 - Porównanie binarne. Uwzględnia wielkość znaków. 'vbTextCompare 1 - Porównanie tekstowe. Nie uwzględnia wielkości znaków 'Przejdź w pętli po wszystkich państwach 'i dodaj do tablicy kraje spełniające warunki 1 For x = LBound(mavKrajeBaza) To UBound(mavKrajeBaza) 'Zaczytaj nazwę kraju 2 sKraj = mavKrajeBaza(x) 'Dodaj do tablicy kraje spełniające kryteria 3 If InStr(1, sKraj, sFiltr, miTrybPor) > 0 Then 'Zwiększ rozmiar tablicy 'i dodaj do niej kraj 4 r = r + 1 5 ReDim Preserve avTemp(1 To r) 6 avTemp(r) = sKraj 7 End If 8 Next x '// For x = LBound(mavKrajeBaza) To UBound(mavKrajeBaza) 'Zaczytaj wartość avTemp do NowaListaKrajow 9 If r <> 0 Then 10 NowaListaKrajow = avTemp 11 Else 12 NowaListaKrajow = Array(vbNullString) 13 End If End Function |
Zmiana w polu filtra
W momencie zmiany wpisu w polu filtra wyzwalane jest zdarzenie Change, które uruchamia funkcję filtrującą i wczytuje nową listę krajów do kontrolki lstKraje.
|
1 2 3 4 5 6 7 8 9 10 11 |
Private Sub txtFiltr_Change() 'Wywołaj funkcję, która tworzy listę krajów po przefiltrowaniu 1 mavKrajeFiltr = NowaListaKrajow(Me.txtFiltr.Text) 'Zaczytaj tą nową listę jako źródło dla lstKraje 2 Me.lstKraje.List = mavKrajeFiltr End Sub |
Kliknięcie w przycisk opcji (Nie/Tak)
Taka sama procedura jest wykonywana jeśli user kliknie w przycisk opcji. Znowu uruchamiamy funkcję filtrującą i wgrywamy listę państw do kontrolki lstKraje.
Ale wcześniej mamy jeszcze jedną linię kodu, która ustawia nam wartość zmiennej prywatnej miTrybPor. Musimy wiedzieć na samym początku czy funkcja filtrująca ma uwzględniać wielkość liter, czy też nie.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
' Kliknięcie w przycisk opcji optNie Private Sub optNie_Click() 'Nie rozróżniamy wielkości liter 1 miTrybPor = 1 'Wywołaj funkcję, która tworzy listę krajów po przefiltrowaniu 2 mavKrajeFiltr = NowaListaKrajow(Me.txtFiltr.Text) 'Zaczytaj tą nową listę jako źródło dla lstKraje 3 Me.lstKraje.List = mavKrajeFiltr End Sub |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
' Kliknięcie w przycisk opcji optTak Private Sub optTak_Click() 'Rozróżniamy wielkość liter 1 miTrybPor = 0 'Wywołaj funkcję, która tworzy listę krajów po przefiltrowaniu 2 mavKrajeFiltr = NowaListaKrajow(Me.txtFiltr.Text) 'Zaczytaj tą nową listę jako źródło dla lstKraje 3 Me.lstKraje.List = mavKrajeFiltr End Sub |
Wybór kraju na liście
Pozwalamy na wybór tylko jednego kraju z listy. W momencie takiego wyboru, nazwa kraju jest zapisywana do zmiennej prywatnej msKrajWybor.
|
1 2 3 4 5 |
Private Sub lstKraje_Click() msKrajWybor = Me.lstKraje.Text End Sub |
Kliknięcie w przycisk (Anuluj/Dodaj)
Kliknięcie w przycisk Anuluj lub Dodaj ustawia wartość zmiennej prywatnej mbOK. Ta z kolei ustawia wartość właściwości publicznej OK.
Będzie nam to potrzebne, ponieważ kraj zostanie dodany do kolumny C, tylko wtedy jeśli wcześniej użytkownik kliknął Dodaj. Kliknięcie Anuluj nie może powodować dodania kraju do kolumny C.
Kliknięcie w jeden z tych przycisków ponadto ukrywa formularz.
|
1 2 3 4 5 6 |
Private Sub cmdOK_Click() mbOK = True Me.Hide End Sub |
|
1 2 3 4 5 6 |
Private Sub cmdAnuluj_Click() mbOK = False Me.Hide End Sub |
Ukrycie formularza
Ostatnią rzeczą, którą potrzebujemy zrobić jest obsługa krzyżyka na formularzu. Jego celem jest zamknięcie formularza. My nie chcemy tego robić, chcemy ten formularz tylko ukryć.
|
1 2 3 4 5 6 7 8 |
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 1 If CloseMode = vbFormControlMenu Then 2 Cancel = True 3 Me.Hide 4 End If End Sub |
Moduł zwykły
W module zwykłym mamy natomiast makro, które tworzy kopię obiektu UKraj. Następnie wyświetla formularz i pobiera informacje od użytkownika.
Te informacje są zaczytywane do zmiennych, po czym następuje wylogowanie formularza.
Ostatnią fazą działania makra jest sprawdzenie dwóch warunków. Po pierwsze, użytkownik musiał wcześniej kliknąć przycisk Dodaj (a nie Anuluj). Po drugie, musiał wybrać jakieś państwo z przefiltrowanej listy krajów.
Jeśli oba warunki są spełnione – makro dodaje do kolumny C nazwę wybranego kraju.
|
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 69 |
Private Const ms_MODUL As String = "MMakroGlowne" Option Explicit Public gl_BLAD_APLIKACJI As Long Public Sub DodajKrajDoListy() Dim clsKraj As UKraj 'Zmienna obiektowa dla UKraj Dim bCzyOk As Boolean 'Info czy user wybrał OK/Anuluj Dim sWybranyKraj As String 'Kraj wybrany w lstKraje Dim lWyborOst As Long 'Ost. wiersz w kol. C Const sPROC As String = "DodajKrajDoListy" 'Aktywuj obsługę błędów na starcie 1 On Error GoTo ObslugaBledu 'Przypisz zmienną obiektową 2 Set clsKraj = New UKraj 'Wyświetl formę 3 clsKraj.Show vbModal 'Zaczytaj kraj i sprawdź czy OK 4 With clsKraj 5 bCzyOk = .OK 6 sWybranyKraj = .KrajWybor 7 End With 'Wyloguj formularz 8 Unload clsKraj 'Dodaj dane do kol. C 'jeśli spełnione warunki 9 If bCzyOk Then 10 If Len(sWybranyKraj) <> 0 Then 'Ustal gdzie wstawić 11 lWyborOst = lOstatni(wksKraje.Range("C:C")) 'Dodaj kraj do listy 12 wksKraje.Cells(lWyborOst, "C").Offset(1, 0).Value = sWybranyKraj 13 End If '// If Len(sWybranyKraj) <> 0 Then 14 End If '// If bCzyOk Then Wyjscie: 15 Set clsKraj = Nothing 16 gl_BLAD_APLIKACJI = 0 17 On Error GoTo 0 18 Exit Sub ObslugaBledu: 19 Application.ScreenUpdating = True 20 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() 21 gl_BLAD_APLIKACJI = Err.Number 22 GoTo Wyjscie End Sub |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
Public Function lOstatni(ByRef rngKolumna As Range) As Long '// Funkcja zwraca numer ostatniego niepustego wiersza w zakresie jednokolumnowym. Dim lTekst As Long Dim lLiczba As Long 'Sprawdź pozycję ostatniego tekstu i ostatniej liczby 1 On Error Resume Next 2 lTekst = WorksheetFunction.Match("żżż", rngKolumna, 1) 3 lLiczba = WorksheetFunction.Match(9.99999999999999E+307, rngKolumna, 1) 4 On Error GoTo 0 'Ostatni wiersz jest w tym przypadku wartością największą 5 lOstatni = WorksheetFunction.Max(lTekst, lLiczba) End Function |
Film na Vlogu
Plik XLSM
Pobierz plik i przeanalizuj kod metodą krokową (F8).
