Dzisiejsza notka będzie dość obszerna, na pewno nie będzie to prosty trik.
Idea Listy Kaskadowej
Chociaż samo założenie tworzenia listy kaskadowej (zawężającej) jest dość proste, to postanowiłem pod ten cel zaprojektować i oprogramować specjalny formularz, którego działanie szczegółowo opiszę.
Idea listy kaskadowej jest dość popularna w arkuszach Excela i zwykle sprowadza się do wpisania odpowiedniej formuły do pola związanego z poprawnością danych.
Z drugiej strony, chyba ani razu nie spotkałem się z sytuacją, aby ktoś przedstawił rozwiązanie w oparciu o formularz VBA. Zatem, do dzieła!
Idea Formularza
Jako, że prywatnie jestem miłośnikiem sportu, zadanie to wykonałem w oparciu o tą dziedzinę – a mówiąc ściślej, koszykówkę NBA.
Nie taki diabeł straszny – już tłumaczę o co chodzi.
W zawodowej lidze koszykarskiej NBA gra 30 drużyn. Są one podzielone równomiernie na dwie konferencje (wschodnią i zachodnią). Dodatkowo każda z tych dwóch konferencji jest podzielona na trzy równomierne dywizje. W każdej dywizji znajduje się pięć zespołów. Proste, prawda? Obrazowo można to pokazać w ten sposób.
Jak to się ma do naszej listy zawężającej? Dokładnie tak jak myślisz!
Najpierw wybierzemy sobie konferencję, potem dywizję, a na końcu konkretną drużynę, której logo będziemy chcieli wyświetlić na kontrolce Image.
Screeny
Zacznę może przewrotnie, pokazując efekt końcowy, a potem omówię warunki i wkleję kod.
Zdarzenia
Główną ideę znamy. Kluczowa jest odpowiedź na pytanie – co ma się dziać gdy zdecydujemy się w coś kliknąć, coś wybrać.
Inicjalizacja formularza.
Zazwyczaj jest tak, że przy uruchomieniu formularza ładują się ustawienia startowe np. unikatowe dane do pola listy. W tym przypadku nie musimy tego robić, ponieważ mamy tylko dwie konferencje: wschodnią i zachodnią. W takiej sytuacji wystarczy skorzystać z przycisków opcji – nie ma sensu tworzyć pola listy czy pola kombi w przypadku gdy mamy tylko dwie możliwości.
Nie musimy ładować ani listy dywizji, ani listy klubów. Te informacje są podrzędne względem konferencji i będą ładowane zależnie od tego czy klikniemy na Wschodnia czy Zachodnia.
Wybór Konferencji
Wybranie konkretnej konferencji powinno generować kilka rzeczy.
- opcjonalnie – możemy zapisać do zmiennej (poziomu modułu) wybraną konferencję. Taka informacja będzie wtedy gdzieś przechowywana
- najważniejsze – musimy wyzwolić funkcję, która na podstawie argumentu (konferencja) zwróci nam w wyniku tablicę podległych jej dywizji
- konsekwencja poprzedniego punktu – mając unikatową listę dywizji przypisanych do danej konferencji – musimy ją załadować jako źródło do pola lstDywizja
- sprzątanie, część I – musimy wyzerować tablicę z listą klubów, ponieważ nie mamy jeszcze zaznaczonej dywizji, tylko samą konferencję
- sprzątanie, część II – musimy usunąć logo klubu, jeśli takowe jest wyświetlone na formularzu- w takiej sytuacji możemy np. wstawić uniwersalne logo ligi NBA
Wybór Dywizji
Jeżeli wybraliśmy już konferencję to wyświetliła się lista trzech dywizji w jej obrębie.
Zastanówmy się, co powinno się stać jeśli wybierzemy np. dywizję centralną.
- opcjonalnie – możemy zapisać do zmiennej (poziomu modułu) wybraną dywizję. Taka informacja będzie wtedy gdzieś przechowywana.
- najważniejsze – musimy wyzwolić funkcję, która na podstawie argumentu (dywizja) zwróci nam w wyniku tablicę klubów przypisanych do niej.
- konsekwencja poprzedniego – mając unikatową listę klubów NBA przypisanych do danej dywizji – musimy ją załadować jako źródło do pola lstKluby
- d) sprzątanie, część I – musimy usunąć logo klubu, jeśli takowe jest wyświetlone na formularzu- w takiej sytuacji możemy np. wstawić uniwersalne logo ligi NBA
Czyli tutaj praktycznie powtarzamy to co robiliśmy w punkcie wcześniej.
Pomijamy jedynie punkt związany z wyzerowaniem listy klubów, ponieważ wybierając konkretną dywizję, ta lista od razu powinna nam się wyświetlić.
Wybór Klubu
Jeżeli wybraliśmy już dywizję (np. centralną) to wyświetliła nam się lista pięciu drużyn w jej obrębie. Zastanówmy się, co powinno się stać jeśli wybierzemy np. Chicago Bulls.
- opcjonalnie – możemy zapisać do zmiennej (poziomu modułu) wybrany klub. Taka informacja będzie wtedy gdzieś przechowywana.
- najważniejsze – musimy załadować logo tego klubu do kontrolki.
Kod Formularza
Poniżej wklejam cały kod, który znajduje się w module formularza. Pamiętajmy, że formularz jest przykładem klasy, zatem musimy go traktować jako obiekt, do którego możemy się odnosić poprzez właściwości i metody.
Private Const msMODUL As String = "UNBA"
Option Explicit
Private m_sKonferencja As String '// Wybrana konferencja
Private m_sDywizja As String '// Wybrana dywizja
Private m_sKlub As String '// Wybrana drużyna
Private m_avListaDywizji As Variant '// Lista dywizji dla konferencji
Private m_avListaKlubow As Variant '// Lista klubów dla dywizji
Dim m_bOK As Boolean
Private Sub cmdOK_Click()
m_bOK = True
End Sub
Private Sub cmdZamknij_Click()
m_bOK = False
Me.Hide
End Sub
' Powoduje, że znak [x] zachowuje się tak samo, jak przycisk Anuluj.
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
m_bOK = False
Me.Hide
Cancel = True
End If
End Sub
' Zwróć, czy został naciśnięty przycisk OK, czy Anuluj.
Public Property Get OK() As Boolean
OK = mbOK
End Property
'// Obsługa przycisków opcji formularza
Private Sub optWschod_Click()
'Zaczytaj do zmiennej prywatnej wybraną konferencję
1 m_sKonferencja = "Wschodnia"
'Zaczytaj listę dywizji w obrębie danej konferencji
2 m_avListaDywizji = ListaDywizji(Konferencja)
'Utwórz listę dywizji jako źródło dla danej konferencji
3 Me.lstDywizja.List = m_avListaDywizji
'Wyczyść listę z klubami
4 Me.lstKluby.Clear
'Załaduj logo NBA
5 ZaladujLogo ""
End Sub
Private Sub optZachod_Click()
'Zaczytaj do zmiennej prywatnej wybraną konferencję
1 m_sKonferencja = "Zachodnia"
'Zaczytaj listę dywizji w obrębie danej konferencji
2 m_avListaDywizji = ListaDywizji(Konferencja)
'Utwórz listę dywizji jako źródło dla danej konferencji
3 Me.lstDywizja.List = m_avListaDywizji
'Wyczyść listę z klubami
4 Me.lstKluby.Clear
'Załaduj logo NBA
5 ZaladujLogo ""
End Sub
'// Obsługa pól listy
Private Sub lstDywizja_Click()
'Zaczytaj do zmiennej prywatnej zaznaczoną dywizję
1 m_sDywizja = Me.lstDywizja.Text
'Zaczytaj lisę klubów w obrębie danej dywizji
2 m_avListaKlubow = ListaKlubow(Dywizja)
'Utwórz listę klubów jako źródło dla danej dywizji
3 Me.lstKluby.List = m_avListaKlubow
'Załaduj logo NBA
4 ZaladujLogo ""
End Sub
Private Sub lstKluby_Click()
'Zaczytaj do zmiennej prywatnej nazwę klubu
1 m_sKlub = Me.lstKluby.Text
'Załaduj logo klubu
2 ZaladujLogo m_sKlub
End Sub
'// Metody i właściwości
Public Property Get Konferencja() As String: Konferencja = m_sKonferencja: End Property
Public Property Get Dywizja() As String: Dywizja = m_sDywizja: End Property
Public Property Get Klub() As String: Klub = m_sKlub: End Property
Public Function ListaDywizji(ByVal sKonferencja As String) As Variant
Dim lPozycjaKonf As Long
Dim lKlubyKonf As Long
Dim avListaDywizji As Variant
'Sprawdź pierwsze wystąpienie konferencji
1 lPozycjaKonf = WorksheetFunction.Match(sKonferencja, wksTeams.Range("A:A"), 0)
'Ustal ile klubów mamy z każdej konferencji
2 lKlubyKonf = WorksheetFunction.CountIf(wksTeams.Range("A:A"), sKonferencja)
'Zdefiniuj tablicę dywizji
3 avListaDywizji = vUnikaty(wksTeams.Cells(lPozycjaKonf, "B").Resize(lKlubyKonf, 1))
'Zaczytaj tą wartość do funkcji
4 ListaDywizji = avListaDywizji
End Function
Public Function ListaKlubow(ByVal sDywizja As String) As Variant
'// Funkcja, która w wyniku zwraca tablicę z nazwami klubów przypisanych do dywizji
Dim lPozycjaDiv As Long
Dim lKlubyDiv As Long
Dim avListaKlubow As Variant
'Sprawdź pierwsze wystąpienie dywizji
1 lPozycjaDiv = WorksheetFunction.Match(sDywizja, wksTeams.Range("B:B"), 0)
'Ustal ile klubów mamy z każdej dywizji
2 lKlubyDiv = WorksheetFunction.CountIf(wksTeams.Range("B:B"), sDywizja)
'Zdefiniuj tablicę dywizji
3 avListaKlubow = vUnikaty(wksTeams.Cells(lPozycjaDiv, "C").Resize(lKlubyDiv, 1))
'Zaczytaj tą wartość do funkcji
4 ListaKlubow = avListaKlubow
End Function
Private Sub ZaladujLogo(sKlub As String)
'// Metoda ładuje logo klubu do kontrolki imgKlub. W przypadku gdy wywołujemy funkcję
'// z argumentem vbNullString, wówczas ładowane jest logo NBA
Dim sSkrot As String
Dim sLokalizacja As String
'Sprawdź, czy przekazano w argumencie nazwę drużyny
1 If Len(sKlub) <> 0 Then
'Skrócona nazwa drużyny
2 sSkrot = Right$(sKlub, Len(sKlub) - InStrRev(sKlub, " "))
'Sprawdź lokalizację obrazka
3 sLokalizacja = ThisWorkbook.Path & "\LOGO\" & sSkrot & ".gif"
4 Else
sLokalizacja = ThisWorkbook.Path & "\LOGO\nba.gif"
5 End If '// If Len(sKlub) <> 0 Then
'Ładuj logo klubu lub logo NBA
6 Me.imgKlub.Picture = LoadPicture(sLokalizacja)
End Sub
Moduł Zwykły
W module zwykłym mam uniwersalną funkcję, która wyciąga mi w wyniku unikatową listę wpisów, argumentem jest zakres komórek.
Public Function vUnikaty(ByRef rngObszar As Range) As Variant
'// Funkcja jako argument pobiera zakrres komórek arkusza.
'// Zwraca w wyniku jednowymiarową tablicę unikatów.
Dim objSlownik As Object 'Dictionary
Dim avTablica As Variant
Dim r As Long, c As Long
Dim vElement As Variant
'Pobierz listę unikatów do tablicy
1 If rngObszar.Count = 1 Then
2 vUnikaty = rngObszar(1)
3 Exit Function
4 Else
5 avTablica = rngObszar
6 End If
'Utwórz obiekt słownika
7 Set objSlownik = CreateObject("Scripting.Dictionary")
'Przejedź w pętli po wszystkich elementach tablicy
8 For r = LBound(avTablica, 1) To UBound(avTablica, 1)
9 For c = LBound(avTablica, 2) To UBound(avTablica, 2)
'Pobierz unikatowy wpis do zmiennej
10 vElement = avTablica(r, c)
'Gdy wpis nie jest pustą komórką lub błędem
'to dodaj go do słownika.
11 If Not IsError(vElement) Then
12 If Len(vElement) <> 0 Then
13 If Not objSlownik.Exists(vElement) Then
14 objSlownik.Add Key:=vElement, Item:=vElement
15 End If '>>> If Not objSlownik.Exists(vElement) Then
16 End If '>>> If Len(vElement) <> 0 Then
17 End If '>>> If Not IsError(vElement) Then
18 Next c '>>> For c = LBound(avTablica, 2) To UBound(avTablica, 2)
19 Next r '>>> For r = LBound(avTablica, 1) To UBound(avTablica, 1)
'Wynikiem działania funkcji jest tablica unikatowych wpisów
20 vUnikaty = objSlownik.Items
21 Set objSlownik = Nothing
End Function
Makro, które uruchamia formularz może wyglądać np. tak:
Public Sub WyswietlForme()
Dim frmNba As UNBA
Set frmNba = New UNBA
UNBA.Show vbModal
End Sub
Uwagi
Na co powinniśmy zwrócić uwagę, co jest ważne?
- Tabela musi być zorganizowana tak jak na pierwszym screenie, posortowana wg konferencji i dywizji.
- Zdjęcia nie mogą być zapisane do formatu *.png – może być *.gif, *.ico lub *.jpg.
- Wszystkie zdjęcia muszą się znajdować w katalogu LOGO
