Geneza problemu
W jednym z ostatnich projektów stworzonych w VBA dla Excel, stanąłem przed koniecznością zapewnienia odpowiedniego formatu dla wpisywanych w pola tekstowe dat, które później są zapisywane w bazie danych.
Stwierdziłem, że najlepiej gdyby na wzór komponentu jQuery, pojawiał się tzw. "DatePicker", który:
- zapewni odpowiedni format wpisywanej daty,
- będzie działał bez problemu z każdym projektem VBA dla Excel,
- będzie w miarę elastyczny, tzn. będzie można go łatwo modyfikować w przyszłości i ponownie wykorzystywać.
Oczywiście pierwsze kroki skierowałem ku Google :) szukając gotowych rozwiązań (przecież kiedyś, dawno dawno temu była przecież taka kontrolka)...
Okazało się jednak, że obecnie kontrola ta nie jest standardowo dostępna we wszystkich wersjach pakietu Office (ja pracuję na 2010 - Small Business). Na dodatek nie znalałem w swoim systemie innej, która mogłaby ewentualnie służyć jako alternatywa: Microsoft MonthView.
Pozostawiając więc zawiłości związane z prawami licencyjnymi kontrolek, które można pobrać i zainstalować, postanowiłem stworzyć własną, prostą i funkcjonalną kontrolkę, która pozwoli mi na realizację celu.
Okazało się to o wiele szybsze i prostsze zadanie, niż mogło by się wydawać, a jego opis znajdziecie poniżej. Cały, działający plik jest dostępny do pobrania na końcu tej strony
Projekt graficzny kontrolki
Przedstawione rozwiązanie oparte jest oczywiście o tzw. UserForm, czyli standardowy formularz VBA, który można utworzyć w każdym tego typu projekcie.
Stworzyłem nowy UserForm i dodałem do niego następujące kontrolki (licząc od góry):
- Listę rozwijaną dla lat (nazwaną: combo_year)
- Listę rozwijaną dla miesięcy (nazwaną: combo_month)
- Przycisk, który ustawia datę na dziejszą (nazwany: cb_today)
- Etykiety dla oznaczenia dnia tygodnia
- 42 przyciski dla dni miesiąca (nazwane odpowiednio: cb1 ... cb42) - dlaczego 42? Biorąc pod uwagę liczbę dni w miesiącu oraz dni, w których występuje 1-szy dzień, trzeba uwzględnić, że miesiąc może zazębiać się w co najwyżej 6 następujących po sobie tygodniach.
- Etykietę "Wybrana data:"
- Etykietę dla wyświetlenia faktycznie wybranej daty (nazwaną: lbl_selected_date)
- Etykietę, która przechowa nam informacje nt. kontrolki, do której będzie zwracana wybrana data (nazwaną: lbl_control_name) - w jej przypadku własność "Visible" ustawiona została na "False", gdyż nie ma potrzeby, aby była wyświetlana.
- Przycisk "OK" (nazwany: cb_date_pick).
Całość prezentuje się następująco:
Paradoksalnie, stworzenie projektu graficznego jest najbardziej pracochłonne. Zaproponowany kształt oraz rozmieszczenie elementów jest w pełni modyfikowalne. Możecie (do czego zachęcam) dowolnie zmienić układ lub formatowanie wykorzystanych komponentów.
Czas na dopisanie kodu do naszej kontrolki.
Kod sterujący
Nasza kontrolka musi realizować następujące czynności:
- Wyświetlać odpowiednią listę lat
- Wyświetlać odpowiednią listę miesięcy w formacie tekstowym.
- W prawidłowy sposób prezentować kolejne dni wybranego miesiąca i roku.
- Reagować na interakcję z użytkownikiem, czyli wskazywać wybraną datę, umożliwiać wybór dnia dzisiejszego i zwracać datę do kontroli typu TextBox w odpowiednim formacie.
W tym celu, przede wszystkim dobrze by było wiedzieć, ile dni ma wybrany miesiąc. Stwórzmy zatem prostą funkcję użytkownika, która na podstawie danego roku i miesiąca zwróci taką informację:
Function days_in_month(year_no As Integer, month_no As Byte) As Byte
days_in_month = DateDiff("d", CDate(year_no & "-" & month_no & "-01"), DateAdd("m", 1, CDate(year_no & "-" & month_no & "-01")))
End Function
Funkcja wykorzystuje dwie inne funkcje wbudowane w język VBA:
- DateDiff - która oblicza różnicę pomiędzy datami w podanym formacie (u nas są to dni: "d", jako pierwszy argument)
- DateAdd - która zwraca datę, będącą wynikiem dodania do podanej daty określonej liczby jednostek czasu (nas interesuje 1 miesiąc: "m", jako pierwszy argument)
W uproszczeniu mówiąc: nasza funkcja przekształca ciąg znaków składający się z podanego roku, miesiąca i 1-szego dnia w datę i przyjmuje tak uzyskany wynik jako datę wyjściową (pierwszy dzień wybranego okresu czasu). Następnie do tak uzyskanej daty dodaje jeden miesiąc (uzyskując pierwszy dzień kolejnego miesiąca), a następnie wylicza liczbę dni pomiędzy tymi datami.
W kolejnym kroku zadbamy o przekształcenie miesięcy (wyświetlanych w formie tekstowej) w łańcuch, typu: "01", "02" ... "12". W tym celu stworzymy kolejną funkcję, która w prosty sposób, przy użyciu instrukcji warunkowej Select Case, dokona odpowiedniej zmiany:
Function get_month_no_from_name(month_name As String) As String
Select Case month_name
Case "styczeń"
get_month_no_from_name = "01"
Case "luty"
get_month_no_from_name = "02"
Case "marzec"
get_month_no_from_name = "03"
Case "kwiecień"
get_month_no_from_name = "04"
Case "maj"
get_month_no_from_name = "05"
Case "czerwiec"
get_month_no_from_name = "06"
Case "lipiec"
get_month_no_from_name = "07"
Case "sierpień"
get_month_no_from_name = "08"
Case "wrzesień"
get_month_no_from_name = "09"
Case "październik"
get_month_no_from_name = "10"
Case "listopad"
get_month_no_from_name = "11"
Case "grudzień"
get_month_no_from_name = "12"
End Select
End Function
Jedynym argumentem funkcji jest nazwa miesiąca. Ta funkcja nie wymaga specjalnego komentarza. Jej utworzenie ma na celu jedynie uzyskanie większej przejrzystości kodu, gdyż nazwy miesięcy będą przekształcane na podany format jeszcze kilkukrotnie w innych miejscach.
W kolejnym kroku zajmiemy się operacjami niezbędnymi do wykonania zanim jeszcze nasza kontrolka zostanie wyświetlona użytkownikowi.
W tym celu, musimy wykonać szerego operacji podczas zdarzenia Initialize. Warto zauważyć, że np. operacje typu wypełnienie list wyboru przed wyświetleniem kontrolki, nie są możliwe do zrealizowania podczas zdarzenia Load.
Spójrzmy na kod, który jest wykonywany podczas inicjowania formatki:
Private Sub UserForm_Initialize()
Dim counter_year As Long
Dim counter As Long
combo_year.Clear
counter = 0
For counter_year = Year(Now()) - 1 To Year(Now()) + 10 'od poprzedniego roku do bieżącego +10 lat - zmień dowolnie, jeśli potrzebujesz inny przedział
combo_year.AddItem
combo_year.Column(0, counter) = counter_year
counter = counter + 1
Next counter_year
combo_month.Clear 'wyczyść zawartość listy, gdyby "jakimś cudem" zawierała elementy
'dodaj kolejne nazwy miesięcy do listy wyboru
combo_month.AddItem
combo_month.Column(0, 0) = "styczeń"
combo_month.AddItem
combo_month.Column(0, 1) = "luty"
combo_month.AddItem
combo_month.Column(0, 2) = "marzec"
combo_month.AddItem
combo_month.Column(0, 3) = "kwiecień"
combo_month.AddItem
combo_month.Column(0, 4) = "maj"
combo_month.AddItem
combo_month.Column(0, 5) = "czerwiec"
combo_month.AddItem
combo_month.Column(0, 6) = "lipiec"
combo_month.AddItem
combo_month.Column(0, 7) = "sierpień"
combo_month.AddItem
combo_month.Column(0, 8) = "wrzesień"
combo_month.AddItem
combo_month.Column(0, 9) = "październik"
combo_month.AddItem
combo_month.Column(0, 10) = "listopad"
combo_month.AddItem
combo_month.Column(0, 11) = "grudzień"
combo_year.Text = Year(Now()) 'ustal bieżący rok i ustaw odpowiednią wartość kontrolki
Select Case Month(Now()) 'na podstawie numeru miesiąca, ustaw odpowiednią nazwę miesiąca
Case 1
combo_month.Text = "styczeń"
Case 2
combo_month.Text = "luty"
Case 3
combo_month.Text = "marzec"
Case 4
combo_month.Text = "kwiecień"
Case 5
combo_month.Text = "maj"
Case 6
combo_month.Text = "czerwiec"
Case 7
combo_month.Text = "lipiec"
Case 8
combo_month.Text = "sierpień"
Case 9
combo_month.Text = "wrzesień"
Case 10
combo_month.Text = "październik"
Case 11
combo_month.Text = "listopad"
Case 12
combo_month.Text = "grudzień"
End Select
'Resetuj dni (na wszelki wypadek):
For counter = 1 To 42
Me.Controls("cb" & counter).Caption = ""
Me.Controls("cb" & counter).ForeColor = 0
Next counter
'Ustal dzień tygodnia, kiedy jest 1-szy danego miesiąca, a następnie uzupełnij właściwości Caption kontrolek kolejnymi numerami dni, korzystając z ich uporządkowanych nazw:
Dim days_counter As Byte
days_counter = 1
For counter = Weekday(CDate(Year(Now()) & "-" & Month(Now()) & "-01"), vbMonday) To Weekday(CDate(Year(Now()) & "-" & Month(Now()) & "-01"), vbMonday) + days_in_month(Year(Now()), Month(Now())) - 1
Me.Controls("cb" & counter).Caption = days_counter
If days_counter = Day(Now()) Then 'wyróżnij dzień dzisiejszy innym kolorem:
Me.Controls("cb" & counter).ForeColor = 9143808
End If
days_counter = days_counter + 1
Next counter
End Sub
W tym celu, wykorzystujemy zastosowane nazewnictwo dodanych kontrolek ("cb1", "cb2" ... "cd42") oraz funkcję VBA Weekday, przy czym jako drugi argument podajemy vbMonday, jako że nasz tydzień będzie zaczynał się od poniedziałku.
Wypełnienie właściwości Caption odpowiednich przycisków, odbywa się w pętli For ... Next, począwszy od kontrolki z numerem odpowiadającym numerowi dnia tygodnia w pierwszym wierszu przycisków. Czynność jest powtarzana dla takiej ilości kontrolek, ile dni ma wybrany miesiąc.
Teraz pozostaje nam obsłużyć odpowiednie interakcje z użytkownikiem: wybór innego roku, miesiąca, dzień dziejszy oraz zwrócenie wartości wybranej daty do kontrolki typu TextBox.
Aby obsłużyć wybór roku lub miesiąca musimy posłużyć się zdarzeniami Change odpowiednich kontrolek. Spójrzmy na odpowiednie procedury obsługujące te zdarzenia:
Dla roku:
Private Sub combo_year_Change()
Dim counter As Long
'Resetuj dni:
For counter = 1 To 42
Me.Controls("cb" & counter).Caption = ""
Me.Controls("cb" & counter).ForeColor = 0
Next counter
'Ustal dzień tygodnia, kiedy jest 1-szy danego miesiąca:
If combo_month.Text <> "" Then
Dim days_counter As Byte
days_counter = 1
For counter = Weekday(CDate(Year(CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-01")) & "-" & Month(CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-01")) & "-01"), vbMonday) To Weekday(CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-01"), vbMonday) + days_in_month(Year(CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-01")), Month(CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-01"))) - 1
Me.Controls("cb" & counter).Caption = days_counter
If days_counter = Day(Now()) And Year(Now()) = combo_year.Text And Month(Now()) = CInt(get_month_no_from_name(combo_month.Text)) Then Me.Controls("cb" & counter).ForeColor = 9143808
days_counter = days_counter + 1
Next counter
End If
End Sub
Dla miesiąca:
Private Sub combo_month_Change()
Dim counter As Long
'Resetuj dni:
For counter = 1 To 42
Me.Controls("cb" & counter).Caption = ""
Me.Controls("cb" & counter).ForeColor = 0
Next counter
'Ustal dzień tygodnia, kiedy jest 1-szy danego miesiąca:
If combo_month.Text <> "" Then
Dim days_counter As Byte
days_counter = 1
For counter = Weekday(CDate(Year(CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-01")) & "-" & Month(CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-01")) & "-01"), vbMonday) To Weekday(CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-01"), vbMonday) + days_in_month(Year(CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-01")), Month(CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-01"))) - 1
Me.Controls("cb" & counter).Caption = days_counter
If days_counter = Day(Now()) And Year(Now()) = combo_year.Text And Month(Now()) = CInt(get_month_no_from_name(combo_month.Text)) Then Me.Controls("cb" & counter).ForeColor = 9143808
days_counter = days_counter + 1
Next counter
End If
End Sub
Obie wyglądają podobnie. W każdym przypadku ponownie, jak podczas inicjalizacji formatki, odpowiednie kontrolki są resetowane (poprzez ujenolicenie kolorystyki oraz usunięcie właściwości Caption, określany jest pierwszy dzień tygodnia przypadający na pierwszy dzień tygodnia i w pętli For ... Next wypełniane są od nowa oznaczenia dni wybranego okresu czasu.
W przypadku wyboru dnia dzisiejszego obsługujemy zdarzenie domyślne dla przycisku, czyli Click:
Private Sub cb_today_Click()
combo_year.Text = Year(Now())
Select Case Month(Now())
Case 1
combo_month.Text = "styczeń"
Case 2
combo_month.Text = "luty"
Case 3
combo_month.Text = "marzec"
Case 4
combo_month.Text = "kwiecień"
Case 5
combo_month.Text = "maj"
Case 6
combo_month.Text = "czerwiec"
Case 7
combo_month.Text = "lipiec"
Case 8
combo_month.Text = "sierpień"
Case 9
combo_month.Text = "wrzesień"
Case 10
combo_month.Text = "październik"
Case 11
combo_month.Text = "listopad"
Case 12
combo_month.Text = "grudzień"
End Select
lbl_selected_date.Caption = Format(CDate(Now()), "yyyy-MM-dd")
End Sub
Poza powyższymi elementami, niezbędne jest także obsłużenie naciśnięcia przez użytkownika każdego z możliwych dni.
Tu sprawa jest bardzo prosta, dla każdego z dodanych na stałe przycisków tworzymy odpowiednią procedurę obsługującą zdarzenie Click, wg stałęgo schematu:
Private Sub cb1_Click()
If cb1.Caption <> "" Then
lbl_selected_date.Caption = CDate(combo_year.Text & "-" & get_month_no_from_name(combo_month.Text) & "-" & cb1.Caption)
Else
lbl_selected_date.Caption = ""
End If
End Sub
Dzięki zastosowanemu nazewnictwu, wystarczy jedynie podmienić numerację kontrolek o nazwach "cb..." i przekopiować odpowiedni kod. Osobiście, aby ułatwić sobie życie, skopiowałem jedną procedurę do komórek Excela, sparametryzowałem ją wartością pierwszej kolumny (1, 2, 3, .... 42) i łącząc łańcuchy znaków utworzyłem kolejne procedury, które potem po prostu skopiowałem do projektu VBA.
Wykorzystanie kontrolki
Aby przetestować działanie utworzonego DatePickera, dodajmy kolejny UserForm do naszego projektu:
Następnie wstawmy do niego dwie kontrolki:
- TextBox nazwany tb_data,
- CommandButton nazwany cb_select_date,
Możemy ustawić także ikonę kalendarza na przycisku, usuwając właściwość "Caption" i zmieniając właściwość Picture:
Zmieńmy jeszcze czcionkę naszego pola tekstowego na rozmiar 14, ustawmy wyrównanie "od prawej" oraz (najważniejsze!) właściwość Enabled na False (dzięki temu uniemożliwimy wpisywania daty w pole tekstowe "z ręki"):
Jeśli teraz klikniemy dwukrotnie przycisk z ikoną kalendarza, w edytorze pojawi się procedura obsługująca to zdarzenie:
Jej kod uzupełniamy następująco:
Private Sub cb_select_date_Click()
datepicker.lbl_control_name.Caption = "tb_data"
datepicker.Show
End Sub
Jak wspomniano wcześniej, nazwę powiązanej kontrolki przechowujemy we właściwości Caption ukrytej etykiety. W tym miejscu ją tam zapisujemy.
Następnie w kodzie kontrolki tworzymy procedurę obsługującą zwracanie wartości wybranej daty do kontrolki wybranego formularza (w naszym przypadku "UserForm1", gdyż do niego podłączamy nasz DatePicker).
Private Sub cb_date_pick_Click()
If datepicker.lbl_selected_date.Caption = "" Then
MsgBox "Nie wybrano daty"
Exit Sub
End If
UserForm1.Controls(datepicker.lbl_control_name.Caption).Text = datepicker.lbl_selected_date.Caption
datepicker.Hide
End Sub
Kolejne linie kodu mają za zadanie sprawdzić, czy data została w ogóle wybrana, a następnie zwrócić jest wartości do TextBox o przechowywanej nazwie. Dzięki temu, że przechowujemy nazwę powiązanej kontrolki w dynamiczny sposób (w etykiecie), możemy powiązać jeden DatePicker z dowolną liczbą kontrolek typu TextBox na UserForm1.
Na koniec, do pustego arkusza dodajmy formant ActiveX, do którego przypiszemy (dwukrotnie klikając) zdarzenie wyświetlające nasz UserForm1:
i:
Dopiszmy krótki kod:
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
Możemy też we właściwościach przycisku zmienić jego opis:
Po wszystkim, wyłączamy tryb projektowania i możemy nacisnąć przycisk w celu przetestowania działania DatePickera:
Po naciśnięciu przycisku z ikoną kalendarza, pojawi się utworzona kontrolka:
Wystarczy teraz wybrać dowolną datę i nacisnąć "OK", aby data w odpowiednim formacie pojawiła się w polu tekstowym:
Powyższy DatePicker jest tylko sugestią na rozwiązanie problemu wstawiania daty w określonym formacie do różnego rodzaju kontrolek tekstowych. Przy niewielkiej modyfikacji możliwe jest także obsłużenie w podobny sposób komórki Excela.
Plik z gotową kontrolką i przykładem dostępny jest do pobrania
w tym miejscu.
Jeśli macie uwagi, wpisujcie je w komentarzach poniżej :)