ZAŁOŻENIA PODSTRONY 'ZAGADNIENIA VBA'    KLIKNIJ by (roz)winąć

Niniejsza podstrona powstała i będzie uzupełniania w oparciu o frazy, które wprowadzane przez użytkowników wyszukiwarki Google doprowadziły do odwiedzin witryny 'makroExcel - programy w excelu'. Dostęp do tych fraz i haseł zapewnia system statystyk zainstalowany na stronie głównej i podstronach serwisu. Część z szukanych zagadnień dotyczy możliwości zastosowania makr i języka VBA (i tę część przedstawiam na tej stronie), a część dotyczy możliwości czystego Excela (tę część przedstawiam na podstronie Porady Excel. Oczywiście sprecyzowanie tematu poszukiwań jest zadaniem trudnym i opiera się w dużej mierze na moich przypuszczeniach. Przewidywana zawartość działu to artykuły z przykładami i zrzutami ekranu oraz przykładowe makra w postaci listingów lub plików do pobrania. Przykładowe rozwiązania dla większych aplikacji (np. dla hasła 'programy rozliczeniowe dla współnoty mieszkaniowej') i dodatki do Excela będą prezentowane na innych stronach. Często frazy wprowadzane do wyszukiwarki dopuszczają dowolność interpretacji i z tego względu zawartość artykułów stanowi wypadkową mojej wiedzy i przypuszczeń co do zakresu szukanego przez użytkownika materiału. Dla ułatwienia dostępu do gromadzonych artykułów wprowadzam trzy grupy hasłowe:
- Pełen tytuł artykułu lub zagadnienia,
- Frazy wprowadzane do wyszukiwarki Google,
- Listę przykładów makropoleceń w postaci plików do pobrania

Wszystkie zawarte w dziale pliki są również dostępne w zakładce pliki z menu górnego strony. W wielu przypadkach zawarte będą odsyłacze do innych podstron serwisu lub/i pozycji literatury. Mam nadzieję, że ten sposób prowadzenia strony spotka się z akceptacją. Zebrane niżej spisy tematów mają za zadanie ułatwić wyszukanie interesujących dla użytkownika zagadnień, co nie oznacza, że każdy z tych nagłówków to tytuł osobnego artykułu.

Opracowania powstały na podstawie mojej wiedzy w tym zakresie.
Jeżeli zauważasz nieścisłości w tekście proszę o kontakt.

Opracowania własne zagadnień VBA

• Okno komunikatu MsgBox
• Wydruk zakresu arkusza z poziomu VBA
• Zabezpieczenie arkusza przed zmianą danych
• Modyfikacja standardowego menu Excela
• Losowanie liczb w Excelu
• Ukrywanie formantów VBA
• Formant ComboBox Excela
• Formanty ComboBox i ListBox Excela - sposób wypełniania listy
• Daty świąt ruchomych w Excelu
• Funkcja własna w Excelu - argumenty, opis, przynależność
• Kwota słownie w Excelu
• Pętla For ... Each - działanie na elementach zbioru w VBA
• Metoda InputBox Excela - działanie na zakresach
• Makro do sortowania tablic z poziomu VBA
• Zdarzenie 'Change' arkusza /uruchamianie makra przy modyfikacji określonej komórki/
• Sumowanie wartości w komórkach odpowiedniego koloru
• Wywoływanie procedur z innych procedur - zastosowanie instrukcji Call
• Działania na zakresach - metoda 'SpecialCells' obiektu 'Range'
• Graficzny pasek postępu zadania
• Funkcje i interfejs Windows API
• Sterowanie Wordem z poziomu Excela
• Monitorowanie wielokrotnych wpisów w kolumnie Excel
• Pierwsza wolna/ostatnia zajęta komórka w wierszu/kolumnie
• Niewielkie objętościowo zapytania dot. VBA
     - ilość miejsc po przecinku VBA,
     - ustawienie właściwości Visible klasy Worksheet,
     - kilka przycisków opcji w jednym formularzu Excela,
     - visual basic - pobieranie danych z jednego UserForms do drugiego UserForms,
     - jak sprawdzić czy zakres zawiera puste komórki VBA Excel,
     - Cancel, chce wyjść z programu InputBox VBA,
     - wywoływanie makra przy aktywacji arkusza,
     - funkcja vba do obliczania układu równań liniowych met. Gaussa-Jordana,
     - blokowanie wprowadzania liter do TextBox,
     - scalanie komórek z wyśrodkowaniem w VBA,
     - uzupełnianie pustych komórek w tabeli oznaczeniem 'n/a' w excelu,
     - polecenia 'option' w Excelu,
     - odświeżanie ekranu i klawisze Ctrl+Break,
     - formularz powitalny, zablokowanie przycisku 'X' i modalność UserForm,
     - wyłączenie obsługi zdarzeń VBA,
     - automatyczna zmiana nazwy dodawanego arkusza,
     - wywołanie makra o określonej porze - zdarzenie OnTime,
     - blokada menu podręcznego,
     - czyszczenie schowka Excela z poziomu VBA,
     - informowanie użytkownika, że makropolecenie jest wykonywane,
  

Przykłady makr VBA w Excelu

• Kwota słownie
• Lista obecności pracowników
• Rejestr_zakupów
• Losowanie liczb
• Wydruk tabel w Excelu
• Modyfikacja menu górnego w Excelu
• Symbole Face_ID
• Wielkanoc w Excelu
• Równania liniowe met. Gaussa-Jordana
• Zabezpieczenie - TextBox tylko liczby
• Scalanie komórek z wyśrodkowaniem w VBA
• Liczenie arkuszy w skoroszycie i ustalenie widoczności
• Liczenie kolorowych komórek w zakresie
• Zdarzenie Change arkusza /uruchamianie makra przy modyfikacji określonej komórki/
• Sumowanie wartości w komórkach odpowiedniego koloru
• Sortowanie tablic
• Graficzny pasek postępu zadania
• Wydruk dokumentu Worda z poziomu Excela
• Odtwarzanie dźwięku przy zmianie wartości komórki Excela
• Monitorowanie wielokrotnych wpisów w kolumnie Excela
• Formanty ComboBox i ListBox - wypełnianie listy

Frazy wyszukiwarki Google

• xls vba okno informacyjne
• kontynuacja kodu w następnej linii vba
     patrz uwaga na końcu listingu MsgBox
• przycisk 'drukuj' w excelu
• vba wydruk
• ustawienie właściwości printarea klasy pagesetup nie jest możliwe
• selection.printout copies:=1, collate.true=1
• excel drukowanie odpowiednich przedziałów makro
• makro nie pozwala wprowadzać danych w excelu
• application.statusbar
• jak zmienić menu bar w excelu
• face id
• gdzie zapisuje się faceid
• zmiana obrazu przycisku paska narzędzi
• programy losujące excel
• symulacja losowania excel
• ukryj combobox dla warunku excel
• makro dla combobox
• przykładowe użycie combobox w excelu
• excel combobox lista
• tutorial excel 2003 combobox
• excel dodanie combobox
• obsługa lista rozwijana vba
• jak zmienić zakres listy combobox
• tworzenie listy rozwijanej excel zakres
• makro wpisujące zawartość z ComboBox do określonej komórki
• czy excel potrafi rozpoznać po dacie czy to weekend czy dzień roboczy
• jak obliczyć czas soboty niedziele excel
• lista obecności pracowników
• formularz listy obecności
• wielkanoc święta ruchome - algorytm
• kwota słownie w excelu
• słownie xls
• przeliczanie kwoty na formę słowną w excelu
• wynik w textbox przecinek zamiast kropki patrz artykuł:
     Konwersja typu zmiennej z TextBox - przecinek i kropka w VBA
• ilość miejsc po przecinku VBA
• ustawienie właściwości Visible klasy Worksheet
• kilka przycisków opcji w jednym formularzu Excela
• visual basic - pobieranie danych z jednego UserForms do drugiego UserForms
• jak sprawdzić czy zakres zawiera puste komórki VBA Excel
• Cancel, chce wyjść z programu InputBox VBA
• wywoływanie makra przy aktywacji arkusza
• obliczanie równań liniowych met. Gaussa-Jordana
• jak zablokować wprowadzanie liter do textbox vba
• vba wyśrodkowanie wartości komórek w kodzie
• wykonanie ramek w excelu - patrz 'Rysowanie obramowań' w 'Porady - Excel'
• zmiana kropki na przecinek w excelu - patrz między innymi 'Programowanie od kuchni' - zrzut ekranu
• excel 2007 zmiana zabezpieczenia makr - patrz 'Karta Developer na wstążce' w 'Porady - Excel'
• jak uruchomić kartę developer 2007 excel - patrz 'Karta Developer na wstążce' w 'Porady - Excel'
• jak sprawdzić ilość arkuszy w skoroszycie vba
• co zrobić jeżeli chcę w excelu aby liczył mi kolorowe komórki
• jak wywołać makro przy modyfikacji wybranej komórki
• jak sprawdzić czy zmodyfikowano wybrany zakres arkusza
• czy można zbudować formułę w excelu która sumowałyby np. tylko komórki w kolorze czerwonym
• excel makro do sortowania
• pisanie makra na sortowanie excel
• zakres w vba
• makro excel 2007 nazwę nowo dodanego arkusza zmiana
• jak wyczyścić schowek w vba excel
• jak zablokować wielokrotne wpisy w kolumnie Excela

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Funkcja i okno komunikatu MsgBox KLIKNIJ by (roz)winąć

Funkcja MsgBox jest jedną z pierwszych, które poznaje osoba ucząca się języka VBA. Składnia tej funkcji wygląda następująco:
MsgBox (PROMPT,BUTTONS, TITLE, HELPFILE, CONTEXT)
- Parametr PROMPT - treść w oknie komunikatu - jest to jednocześnie jedyny wymagany parametr. Może być zmienną aplikacji,
- Parametr BUTTONS - symbole i przyciski w oknie komunikatu - domyślnie (tzn. wartość nie podana) brak symbolu i jeden przycisk 'OK',
- Parametr TITLE - tytuł okna komunikatu - domyślnie (tzn. wartość nie podana) napis 'Microsoft Excel',
- Parametr HELPFILE - wskazanie pliku pomocy aplikacji (przy bardzo zaawansowanych produkcjach),
- Parametr CONTEXT - wskazanie numeru kontekstu pomocy (przy bardzo zaawansowanych produkcjach),
Parametry możemy określać przez pozycję lub przez nazwę np.
a) MsgBox Title:="Uwaga", Buttons:=4, Prompt:="Wystąpił błąd programu" - składnia podaje trzy parametry przez podanie ich nazwy (kolejność dowolna, nie trzeba używać przecinków dla zasygnalizowania nieistniejących parametrów, nie można używać samego znaku '=' tylko znak ':='),
b) MsgBox "Uwaga", 4, "Wystąpił błąd programu" - składnia podaje trzy parametry (efekt jak wyżej), ale program rozpoznaje je po kolejności w jakiej występują. Jeżeli nie chcemy podawać wartości Buttons składnia wyglądałaby tak:
MsgBox "Uwaga", , "Wystąpił błąd programu",
Powyższe przykłady traktują MsgBox jak polecenie. Jeżeli chcemy pobrać wartość zwrotną (użytkownik ma mieć wpływ na dalsze działanie programu) należy przypisać wartość MsgBox do zmiennej np. typu Long lub Integer (wtedy parametry polecenia stają się parametrami funkcji i jako takie muszą zostać ujęte w nawiasy) np.
Odpowiedz = MsgBox (Title:="Uwaga", Buttons:=4, Prompt:="Wystąpił błąd programu")
Jeszcze jedna uwaga - zamiast numerów przycisków warto używać nazw stałych dostępnych w podpowiedziach edytora (również przy analizowaniu kodu są bardziej czytelne).

Teraz kilka zestawień:
Pierwsza grupa - wartości od 0 do 5 opisują numery i typy przycisków wyświetlanych w oknie:
- wartość 0 - tylko przycisk 'OK' (stała vbOKOnly),
- wartość 1 - przyciski 'OK' i 'Anuluj' (stała vbOKCancel),
- wartość 2 - przyciski 'Przerwij', 'Ponów próbę' i 'Zignoruj' (stała vbAbortRetryIgnore),
- wartośc 3 - przyciski 'Tak', 'Nie' i 'Anuluj' (stała vbYesNoCancel),
- wartość 4 - przyciski 'Tak' i 'Nie' (stała vbYesNo),
- wartość 5 - przyciski 'Ponów próbę' i 'Anuluj' (stała vbRetryCancel),

Druga grupa - wartości 16, 32, 48, 64 opisują styl ikon wyświetlanych w oknie:
- wartość 16 - komunikat błędu (stała vbCritical),
- wartość 32 - komunikat zapytania (stała vbQuestion),
- wartość 48 - komunikat ostrzeżenia (stała vbExclamation),
- wartośc 64 - komunikat informacji (stała vbInformation),

Trzecia grupa - wartości 0, 256, 512 określają domyślnie wybrany przycisk:
- wartość 0 - domyślny jest przycisk 1 (stała vbDefaultButton1),
- wartość 256 - domyślny jest przycisk 2 (stała vbDefaultButton2),
- wartość 512 - domyslny jest przycisk 3 (stała vbDefaultButton3),

Czwarta grupa - wartości 0, 4096 określa modalność okna:
- wartość 0 - okno musi być zamknięte by kontynuować pracę w tej aplikacji (stała vbApplicationModal),
- wartość 4096 - okno musi być zamknięte by kontynuować pracę w każdej aplikacji systemu (stała vbSystemModal),

Wartości zwracane przez funkcję MsgBox można odbierać pod zmienną Integer, stosując instrukcję warunkową If lub Select Case.
Wartość liczbowa przycisku zaznaczonego przez użytkownika:
- wartość 1 - wybrany przycisk 'OK' (stała vbOK),
- wartość 2 - wybrany przycisk 'Anuluj' (stała vbCancel),
- wartość 3 - wybrany przycisk 'Przerwij' (stała vbAbort),
- wartośc 4 - wybrany przycisk 'Ponów próbę' (stała vbRetry),
- wartość 5 - wybrany przycisk 'Zignoruj' (stała vbIgnore),
- wartość 6 - wybrany przycisk 'Tak' (stała vbYes),
- wartość 7 - wybrany przycisk 'Nie' (stała vbNo),

Maksymalna długość napisu wyświetlanego w oknie komunikatu nie może przekraczać 1024 znaków.

Kilka przykładów zastosowania MsgBox Kliknij, żeby (roz)winąć listing

Sub Przyklad_1()
Dim Odpowiedz As Long
Odpowiedz = MsgBox("STRAJK - przestaję pracować", _
vbCritical + vbOKOnly, _
"Przykład 1")
End Sub



Sub Przyklad_2()
Dim Odpowiedz As Long
Odpowiedz = MsgBox("Czy długo jeszcze będziemy pracować?", vbOKOnly + vbYesNo + vbApplicationModal, "Przykład 2")
End Sub



Sub Przyklad_3()
MsgBox Prompt:="Zaraz odechce mi się pracować", _
Buttons:=vbExclamation + vbSystemModal + vbOKCancel + vbDefaultButton1, _
Title:="Przykład 3"
End Sub



Sub Przyklad_4()
MsgBox "Nareszcie fajrant", _
vbInformation, _
"Przykład 4"
End Sub



Sub Przyklad_5()
MsgBox "STRAJK - przestaję pracować" & Chr(10) & _
"Czy długo jeszcze będziemy pracować?" & Chr(10) & _
"Zaraz odechce mi się pracować" & Chr(10) & _
"Nareszcie fajrant" & Chr(10)
End Sub


Uwagi
- wykorzystany w kodach symbol ' _' (spacja i podkreślenie) pozwala pisać jedno polecenie w kilku wierszach
- symbol 'Chr(10)' w ostatnim kodzie to znak przejścia do następnej linijki
- znak '&' pozwala między innymi łączyć łańcuchy tekstowe

Funkcja MsgBox jest jedną z najbardziej przydatnych i tym samym najczęściej używanych funkcji języka VBA. Niektóre z jej zastosowań przedstawiam poniżej:

• z jednym przyciskiem 'OK' może służyć do wyświetlania komunikatów lub/i ostrzeżeń dla użytkownika w trakcie pracy aplikacji,
• z odpowiednio dobranym zestawem przycisków może stanowić odpowiednik prostego okna dialogowego (w wielu przypadkach zamiast osobnego formularza można użyć funkcji MsgBox) - okno wyświetla wartość zmiennej lub zapytanie, a odpowiedź użytkownika zwraca do procedury odpowiednią wartość,
• możliwość wyświetlania wartości zmiennej można stosować w trakcie testowania poszczególnych procedur (np. stosowałem ją by dowiedzieć się, które powtórzenie pętli 'For Next' generuje błąd lub która pętla w dość skomplikowanych algorytmie nie działa zgodnie z założeniami. W tym ostatnim przypadku komunikat brzmiał 'Tu jestem';)

Więcej informacji o funkcji MsgBox (np. tworzenie plików pomocy) można znaleźć w bardziej zaawansowanej literaturze VBA np.
- J. Walkenbach "Excel 2003. Programowanie VBA"
- Pr. zbiorowa "Excel 2007. Programowanie VBA"
Książki prezentowane są na podstronie niniejszej witryny.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Wydruk zakresu arkusza z poziomu VBA KLIKNIJ by (roz)winąć

Po zarejestrowaniu makra ustawiającego zakres i opcje wydruku możemy analizować możliwe do zdefiniowania właściwości wydruku. Niestety w przypadku makra rejestrowanego drukujemy arkusz aktualnie używany i z góry zdefiniowany zakres tabeli. Samodzielne aplikacje powinny mieć dodatkowe funkcje:
- wydruk z innego arkusza niż aktualnie używany,
- wydruk zmiennego zakresu wierszy (w zależności od tego ile wierszy w tabeli jest zajętych).
w bieżącym przykładzie chciałbym przedstawić sposoby w jaki realizuję wydruku dla następujących przypadków:
- wydruk tabeli bieżącego arkusza o znanym i określonym zakresie,
- wydruk tabeli z innego arkusza niż bieżący o określanym w trakcie działania programu zakresie,
- wydruk tabeli z podaniem ilości stron i kopii,
Przykład dołączony do artykułu należy traktować jako czysto poglądowy (jest to czteroarkuszowy plik z tabelami doboru średnic rur stalowych w instalacjach ogrzewania wodnego - przykład pochodzi z mojej pracy zawodowej). Jest on do ściągnięcia w postaci archiwum samorozpakowującego na stronie pliki.
W programach, które piszę dla potrzeb mojej pracy zawodowej wykorzystywałem różne kombinacje w/w algorytmów np:
- wydruk tabeli o zmiennej ilości wierszy i kolumn (znany tylko początek tabeli),
- wydruk tabeli z podaną np. w oknie TextBox formularza ilością kopii,
- wydruk powtarzalnej korespondencji dla której program sam ustalał ilość stron wydruku (równą ilości użytych danych)
Komunikaty o błędach np. 'ustawienie właściwości printarea klasy pagesetup nie jest możliwe' związane były w moim przypadku ze złym doborem typów zmiennych lub z próbą wydruku dla arkusza ukrytego/nieaktywnego.
W trakcie pracy ustaliłem dwie możliwości przygotowania wydruku z aplikacji:
a) program ustawia wszystkie możliwe parametry (marginesy, orientację papieru, nagłówki, stopki itp.),
b) ustawiam wszystko w arkuszu i drukuję, a w VBA tylko określam zakres i ilość stron,
Zaletą pierwszej metody jest pewna miara niezależności, wadą (przynajmniej w moim przypadku) bardzo długi czas wydruku,
Zaletą drugiej metody jest szybkość wydruku, wadą - czasami Excel zapomina o wcześniejszych ustawieniach.
Przyjąłem metodą drugą, przy czym właściwość Visible arkuszy, z których następuje wydruk ustawiam na 'Hidden', a nie na 'VeryHidden'. Różnica jest taka, że arkusza Very-ukrytego nie widać w menu programu (dla Excela 2003 pasek Format/arkusz/odkryj), a arkusz tylko ukryty można tam ujawnić. Jak aplikacja zapomni ustawień np. orientacji papieru wchodzę do ustawień i w kilka sekund poprawiam. W sytuacji mojej firmy jest to wystarczające.
Mała uwaga - arkusze 'VeryHidden' można ujawnić komendami VBA z poziomu innego pliku.
Załączony w dziale 'pliki' arkusz zawiera trzy przyciski pod którymi wprowadzone są makra z listingów.

Niektóre opcje wydruku - makro rejestrowane Kliknij, żeby (roz)winąć listing

Sub Ustawienia_druku()
Range("B1:K203").Select ActiveSheet.PageSetup.PrintArea = "$B$1:$K$203"
ActiveSheet.PageSetup.PrintArea = "$B$1:$K$203"
ActiveSheet.PageSetup.CenterFooterPicture.Filename = _
"C:\Documents and Settings\Grzegorz Koralewski\Moje dokumenty\Moje obrazy\Okno_msgbox_2.png"
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$B$1:$K$203"
With ActiveSheet.PageSetup
.LeftHeader = "Nagłówek lewy"
.CenterHeader = "Nagłówek środek"
.RightHeader = "Nagłówek prawy"
.LeftFooter = "Stopka lewa"
.CenterFooter = "Stopka środek &P&N&D&T&Z&F&F&A&G"
.RightFooter = "Stopka prawa"
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.78740157480315)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 1200
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintPreview
End Sub

Uwagi
- nie są to wszystkie możliwe do ustawienia opcje
- nazwa pliku z początku listingu to definicja grafiki w stopce


Wydruk tabeli o stałym zakresie z bieżącego arkusza Kliknij, żeby (roz)winąć listing

Sub Wydruk_biezacy_arkusz_staly_zakres()

Dim Zakres_druku As Areas
Dim Obszar_druku As String

'POKAZANIE ARKUSZA /DLA NIEWIDOCZNEGO NIE MOŻNA USTAWIĆ WYDRUKU/
Arkusz1.Visible = xlSheetVisible

'USTAWIANIE OBSZARU WYDRUKU
'(SYMBOLE R i C to odpowiednio wiersze (rows) i kolumny (columns)

Obszar_druku = "='Stal_55_40'!R1C2:R203C11"

Worksheets("Stal_55_40").Names.Add Name:="Zakres_druku", RefersToR1C1:= _
Obszar_druku

'DRUKOWANIE
Worksheets("Stal_55_40").PageSetup.PrintArea = "Zakres_druku"

Worksheets("Stal_55_40").PrintOut Copies:=1, Collate:=True

'PONOWNE UKRYCIE ARKUSZA USTAWIONE JAKO KOMENTARZ
'LIKWIDACJA SYMBOLU ' SPOWODUJE ZAKRYCIE ARKUSZA PO ZAKOŃCZENIU WYDRUKU
'Arkusz1.Visible = xlSheetHidden

End Sub


Wydruk tabeli o zmiennej ilości wierszy z innego niż bieżący arkusza Kliknij, żeby (roz)winąć listing

Sub Wydruk_zmienne_wiersze_inny_arkusz()

Dim Kontrola As Range
Dim Proba As Areas
Dim ss As String
Dim s As Single
Dim Obszar_druku As String

'Zaznaczanie obszaru wydruku
'ustawienie komórki kontrolnej
Set Kontrola = Arkusz2.Range("B2")
ss = ""
s = 2

'Zmienna ss typu String to zawartość komórki Kontrola
'zmienna s typu single to liczba zwiększana z każdym wykonaniem
'pętli Do Loop Until
'jej wartość początkowa związana jest z początkiem wydruku
'z każdym wykonaniem pętli Kontrola jest komórką o jeden wiersz niżej

Do
ss = Kontrola.Value
If ss <> "" Then Set Kontrola = Kontrola.Offset(1, 0)
If ss <> "" Then s = s + 1
Loop Until ss = ""

'Pętla wykonywana jest do czasu aż komórka Kontrola jest pusta tzn.
'pierwszy wolna komórka w kolumnie B

s = s - 1
Arkusz2.Visible = xlSheetVisible

'W zmiennej Obszar_druku stosuję połączenie uzyskanej wartości zmiennej s
'z wartościami zdefiniowanymi
Obszar_druku = "='Stal_70_50'!R1C2:R" & s & "C11"

Worksheets("Stal_70_50").Names.Add Name:="Zakres_druku", RefersToR1C1:= _
Obszar_druku
'DRUKOWANIE
Worksheets("Stal_70_50").PageSetup.PrintArea = "Zakres_druku"
Worksheets("Stal_70_50").PrintOut Copies:=1, Collate:=True

'na zakończenie można ustawić widoczność arkusza na hidden

Range("A1").Select
'Arkusz2.Visible = xlSheetHidden

End Sub

Wydruk tabeli z podaniem ilości kopii Kliknij, żeby (roz)winąć listing

Sub Wydruk_arkusza_z_podaniem_ilosci_kopii()

Dim Komunikat As Integer
Dim i As Integer
Dim Zakres_druku As Areas
Dim Obszar_druku As String

On Error GoTo Błąd:

i = InputBox("Podaj ilość kopii", "WCZYTYWANIE DANYCH", "2")

'Drukowanie
Arkusz1.Visible = xlSheetVisible

Obszar_druku = "='Stal_55_40'!R1C2:R203C11"
'
Worksheets("Stal_55_40").Names.Add Name:="Zakres_druku", RefersToR1C1:= _
Obszar_druku

Worksheets("Stal_55_40").PageSetup.PrintArea = "Zakres_druku"

'Podaną w funkcji InputBox zmienną używamy w ustawieniach wydruku

Worksheets("Stal_55_40").PrintOut Copies:=i, Collate:=True

'Arkusz1.Visible = xlSheetHidden

Exit Sub
Błąd: Komunikat = MsgBox("Wystąpił błąd. Spróbuj jeszcze raz podając ilość kopii")

End Sub

W niniejszym punkcie przedstawiono niektóre możliwości wydruku zakresu arkusza z poziomu VBA. Punktem wyjścia dla rozważań jest makro rejestrowane, w dalszej części załączono listingi z propozycjami makr drukujących w kilku różnych odmianach. Dla osób zainteresowanych tematem wydruków VBA polecam artykuły z działu 'Programy do kuchni':
- Czytelne wydruki z programu VBA?
- Wydruk z poziomu Visual Basica tabeli o zmiennym zakresie wierszy/kolumn
- Wydruk tabel z formułami - sumowaniem/kopiowaniem i usuwaniem wierszy z poziomu VBA
- Ustawienia wstępne wydruku, a szybkość działania programu VBA
Excel ma również możliwość druku dokumentu Worda (tworzy zmienną obiektową). Excel może, ale nie musi informować użytkownika aplikacji, że zarządza w danej procedurze Wordem - osobom zainteresowanym takim rozwiązaniem polecam:
- Wydruk dokumentu Worda z poziomu Excela.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Zabezpieczenie arkusza przed zmianą danych KLIKNIJ by (roz)winąć

Temat zabezpieczenia arkusza lub części komórek tego arkusza przed wprowadzaniem danych jest omówiony w dziale Porady Excel. W tym dziale chciałbym omówić sposób zabezpieczenia wprowadzony przeze mnie w aplikacjach przedstawionych na stronie. Przede wszystkim tam gdzie jest to możliwe (ze względu na wymagania docelowego użytkownika) obsługę aplikacji wprowadzam z formularzy wywoływanych z osobnego menu. Arkusze robocze są ukryte przed użytkownikiem przez odpowiednie zastosowanie właściwości Visible klasy Worksheet (xlSheetHidden lub xlSheetVeryHidden). Różnica między tymi dwoma sposobami ukrycia polega na tym, że arkusz ukryty można uwidocznić bez używania edytora VBA - arkusze będą widoczne (dla Excela 2003) w menu 'Format/Arkusz/Odkryj', a arkusze VeryHidden będą niewidoczne. Ujawnić można je tylko z poziomu edytora VBA lub z poziomu innego pliku (też poleceniami VBA). Dla arkuszy roboczych dobrze jest stosować Hidden, dla arkuszy zawierających dane pomocnicze VeryHidden. Arkusz można też programowo zabezpieczyć wprowdzonym hasłem. Polecenie VBA to 'Arkusz1.Protect(hasło_użytkownika)'. Dla zdjęcia zabezpieczenia używane jest polecenie 'Arkusz1.Unprotect(hasło_użytkownika)'. Ten sposób wprowadzenie hasła powoduje, że do tej roli używany jest wartość stała dla aplikacji, co oczywiście nie jest najkorzystniejsze. Użycie hasła definiowanego wymaga przypisania hasła do zmiennej (np. typu String). Zabezpieczenie takim hasłem wymaga polecenia 'Arkusz1.Protect([haslo_uzytkownika])', gdzie 'haslo_uzytkowniak' jest zmienną typu String pod którą zapisuję wartość pobraną z jednej z komórek arkusza pomocniczego (właściwość VeryHidden). W programie w przycisku opcji wprowadzam możliwość zmiany hasła. Służy do tego formularz z trzema oknami tekstowymi. W pierwszym oknie wprowadzam dotychczasowe hasło, w dwóch pozostałych nowe hasło wraz z powtórzeniem. Zatwierdzenie nowego hasła polega na odblokowaniu wszystkich arkuszy dotychczasowym hasłem i zabezpieczeniu ich nowym hasłem. Wprowadzanie danych do arkusza wprowadzam analogicznie - blok procedury zapisu danych 'ubieram' w polecenia Unprotect i Protect. W ten sposób w trakcie wykonywania procedury arkusz jest odbezpieczony, ale koniec procedury blokuje go ponownie. Na formularzu zmiany hasła dla okien tekstowych TextBox w oknie 'Properties' ustawiam parametr 'PasswordChar' (domyślnie pusty) na znak '*'. W ten sposób wszystkie znaki wprowadzane do takiego okna zastąpione zostaną symbolem. W trakcie prac nad kolejnymi programami zauważyłem znaczącą wadę opisanego rozwiązania - zabezpieczenie hasłem powoduje, że plik nie może działać jako udostępniony w sieci. Nawet podanie prawidłowego hasła nie eliminuje tej przypadłości. Z tego względu stopniowo rezygnuję z tego typu zabepieczenia wprowadzając inne - przy pełnej obsłudze programu z formularzy, jeżeli chcę zabezpieczyć arkusz przed wprowadzeniem danych na podstawie wyników weryfikacji podanego hasła blokuję dostęp do formularza lub jego części. Wymaga to odpowiedniej obsługi zdarzeń Initialize i Activate dla UserForm, ale jest rozwiązaniem dużo wygodniejszym w praktyce mojej firmy. W przykładzie zawarte są dwa formularze: wprowadzania hasła i wprowadzania danych. Formularze wywoływane są przez kliknięcie na odpowiednio opisanym przycisku. Przykładowy arkusz z tabelką widoczny jest podczas pracy pliku przykładowego.

Kod formularzy pliku przykładowego Kliknij, żeby (roz)winąć listing

------- USERFORM 1 - WPROWADZANIA DANYCH ---------
Private Sub CommandButton1_Click()

Dim Haslo_uzytkownika As String
Dim i As String
Dim komunikat As Integer
Dim komorka As Range

On Error GoTo Blad

Set komorka = Arkusz1.Range("B8")
Do
Set komorka = komorka.Offset(1, 0)
Loop Until komorka.Value = ""

Haslo_uzytkownika = Arkusz1.Range("C4").Value

Arkusz1.Unprotect ([Haslo_uzytkownika])

komorka.Value = CCur(TextBox1.Value)

Arkusz1.Protect ([Haslo_uzytkownika])

Exit Sub
Blad:
Arkusz1.Protect ([Haslo_uzytkownika])
i = MsgBox("Tylko wartości liczbowe ze znakiem ','", _
vbInformation, "PRZYKŁAD ZABEZPIECZENIA")

End Sub

------- USERFORM 2 - WPROWADZANIA HASŁA ---------
Private Sub CommandButton1_Click()

Dim Haslo_uzytkownika As String
Dim i As String

Haslo_uzytkownika = Arkusz1.Range("C4").Value

If TextBox1.Value = Haslo_uzytkownika And TextBox2.Value = TextBox3.Value Then
i = MsgBox("Nowe hasło użytkownika zostało wprowadzone", _
vbInformation, "PRZYKŁAD ZABEZPIECZENIA")
Arkusz1.Unprotect ([Haslo_uzytkownika])
End If

If TextBox1.Value = Haslo_uzytkownika And TextBox2.Value = TextBox3.Value Then _
Arkusz1.Range("C4").Value = TextBox2.Value
If TextBox1.Value = Haslo_uzytkownika And TextBox2.Value = TextBox3.Value Then _
UserForm2.Hide

If TextBox1.Value <> Haslo_uzytkownika Then _
i = MsgBox("Hasło nieprawidłowe - odmowa dostępu", vbInformation, "SZPIEG, SZPIEG, SZPIEG !!!")
If TextBox1.Value <> Haslo_uzytkownika Then UserForm2.Hide

If TextBox2.Value <> TextBox3.Value Then _
i = MsgBox("Wpisy nowego hasło nie są takie same. Zmiana nie została wprowadzona", _
vbInformation, "PRZYKŁAD ZABEZPIECZENIA")
If TextBox2.Value <> TextBox3.Value Then UserForm2.Hide

Haslo_uzytkownika = Arkusz1.Range("C4").Value
Arkusz1.Protect ([Haslo_uzytkownika])

End Sub

Private Sub CommandButton2_Click()
UserForm2.Hide
End Sub

Private Sub UserForm_Activate()

TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""

End Sub

W niniejszym punkcie przedstawiono niektóre możliwości arkusza zabezpieczenia arkusza z poziomu VBA przed zmianą danych. Zakres punktu obejmuje sposób zabezpieczenia arkuszy stosowany przeze mnie w aplikacjach i programach. Wykorzystywane są polecenia Protect lub ukrywanie arkuszy z ewentualnym udostępnieniem po pozytywnej weryfikacji hasła. Ręczne zabezpieczenie arkusza lub zakresu komórek przed zmianą (wykorzystywane w plikach udostępnianych osobom trzecim) jest tematem punktu z działu Porady Excel Udostępnianie skoroszytu, arkusza lub części komórek.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Modyfikacja standardowego menu Excela KLIKNIJ by (roz)winąć

Arkusz kalkulacyjny Excel był i jest na tyle elastycznym programem, że pozwala użytkownikowi na modyfikację wbudowanych pasków narzędzi lub/i zastępowanie ich rozwiązaniami własnymi. Paski narzędzi Excela można umownie podzielić na:
- pasek menu (górny pasek programu bezpośrednio pod paskiem tytułowym aplikacji), zawiera pojedyncze menu rozwijane 'Plik', 'Edycja' itd.
- pasek narzędzi (Excel zawiera kilkadziesiąt wbudowanych pasków narzędzi np. 'Standardowy', 'Formatowanie', 'Formularze' itp.) są to paski z przyciskami, obsługującymi pewne działania np. 'kopiuj' i 'wklej'. Standardowo Excel 2003 posiada możliwość przygotowania własnego paska narzędzi. Działanie to w swej podstawowej formie nie wymaga znajomości VBA,
- pasek menu podręcznego (jeżeli w obrębie arkusza, klikniemy prawym przyciskiem myszy, ukaże się rozwijane menu z dostępnymi poleceniami).
Pasek menu jest nietypowym paskiem narzędzi - po kliknięciu i przytrzymaniu prawym przyciskiem myszy w obrębie menu, możemy ten pasek przesunąć w inne miejsce tak jak każdy inny. Podobną metodą uruchamiamy spis dostępnych pasków narzędzi dla całego programu (jest to w dużej części przypadków cecha wspólna programów pod system Windows - tak samo zachowuje się np. Auto-Cad). Wszystkie wymienione elementy sterowania możemy w zasadzie dowolnie modyfikować, przy czym w tym punkcie zajmiemy się modyfikacją paska menu. Procedury pisane pod Excelem 2003 działają również pod 2007 ponieważ ten program, mimo zastosowania wstążki szybkiego dostępu, zachowuje wewnętrznie dotychczasowe uporządkowanie pasków poleceń. Dla Excela 2007 efekt działania procedur będzie jednak nieco inny - na wstążce pojawia się zakładka 'Dodatki'. W dziale polecane strony załączyłem link do strony z nieoficjalnym dodatkiem zastępującym wstążkę układem menu poprzednich wersji - od razu zaznaczam, że nie sprawdziłem działania tego dodatku osobiście.
Wszystkie menu, paski narzędzi i menu podręczne wbudowane w aplikacje pakietu Office zawiera kolekcja CommandBars. podczas tworzenia pasków poleceń na poziomie VBA używamy metody 'Add' w wymienionej kolekcji jednocześnie określając, którego typu paska chcemy użyć:
- pasek narzędzi - msoBarTypeNormal,
- pasek menu - msoBarTypeMenuBar,
- menu podręczne - msoBarTypePopup,
Kontrolki na paskach narzędzi również mają swoje typy np.
- polecenie paska menu lub paska narzędzi - msoControlButton,
- msoControlPopup - rozwijane menu na pasku zawierające własne kontrolki,
Określając własną kontrolkę możemy przypisać makro do jej właściwości 'OnAction'.
W załączonym pliku pokazuję dodanie menu 'Ćwiczenie' do standardowego menu Excela przed menu 'Pomoc' lub (w przypadku, gdy menu 'Pomoc' nie istnieje) na końcu paska. Do każdego z przyciskow menu przypisane jest makro wyświetlające komunikat. Procedura zmiany menu umieszczona jest w 'Module 1', a makra w 'Module 2' pliku.
Wstawienie własnego paska menu przed jedno z istniejących menu najwyższego poziomu wymaga znajomości ID:
- Menu Plik - ID 30002,
- menu Edycja - ID 30003,
- menu Widok - ID 30004,
- menu Wstaw - ID 30005,
- menu Format - ID 30006,
- menu Narzędzia - ID 30007,
- menu Dane - ID 30011,
- menu Wykres - ID 30022,
- menu Okno - ID 30009,
- menu Pomoc - ID 30010,
Obrazy przycisków przy poleceniach (FaceId) zostały omówione w punkcie Symbole Face ID. Jeżeli chodzi o literaturę do tego zagadnienia to pisząc programy korzystałem z książek pani Snarskiej i Korol. Niestety ze względu na zakres obu prac zawierają one jedynie pojedyncze przykłady. Ich interpretacja była długa i dość trudna. Udało mi się osiągnąć zamierzony efekt (musiałem zastosować własne menu w kilku programach między innymi FAKTURA WEWNĘTRZNA, OKNA SPISY czy REJESTR ZAKUPÓW), ale niektóre sformułowania były dla mnie mylące. Swoją bibliotekę poszerzyłem i dlatego mogę polecić:
- J. Walkenbach "Excel 2003. Programowanie VBA"
- Pr. zbiorowa "Excel 2007. Programowanie VBA"
Obydwie książki (prezentowane na podstronie niniejszej witryny) poświęcają modyfikacjom menu osobne kilkudzisięciostronicowe rozdziały, przedstawiając materiał w sposób uporządkowany, jasny i dużo bardziej przydatny (zresztą prezentowany przykład z niewielkimi zmianami pochodzi właśnie z książki pana Walkenbacha).
Nie zamieszczam przykładów całkowitego zastąpienia menu Excela własnym - w mojej praktyce to rozwiązanie okazało się nie do końca trafne (tym niemniej właśnie całkowite zastąpienie menu prezentowane jest w książce pani Snarskiej).
Tematy powiązany z bieżącym przedstawiane na tej stronie (oprócz wymienionego wyżej Face ID) to:
- Uzupełnienie MS Excel o własne menu - Strona 'Programy od kuchni'
- Zmiana paska menu MS Excel - Strona 'Programy od kuchni'

Listing przykładu zastępowania menu Kliknij, żeby (roz)winąć listing

Sub Dodaj_Nowe_menu()

Dim Menu_Pomoc As CommandBarControl
Dim Nowe_Menu As CommandBarPopup
Dim Przycisk_menu As CommandBarControl
Dim Przycisk_podmenu As CommandBarButton

'Usunięcie menu jeżeli już istnieje
Call Usun_menu

'Odszukanie menu Pomoc
Set Menu_Pomoc = CommandBars(1).FindControl(ID:=30010)

If Menu_Pomoc Is Nothing Then 'Dodanie nowego menu na końcu
Set Nowe_Menu = CommandBars(1).Controls.Add(Type:=msoControlPopup, _
Temporary:=True)
Else 'Dodanie nowego menu przed menu Pomoc
Set Nowe_Menu = CommandBars(1).Controls.Add(Type:=msoControlPopup, _
Before:=Menu_Pomoc.Index, Temporary:=True)
End If

'Parametr 'Temporary:=True' określa, że menu
'zostanie usunięte przy zamykaniu Excela

'dodanie nazwy menu
Nowe_Menu.Caption = "&Cwiczenie"

'Dodanie znaku '&' przed nazwą określa, że litera C jest klawiszem
'skrótu tzn. lewy Alt + C uruchomią menu

'Pierwsza pozycja menu
Set Przycisk_menu = Nowe_Menu.Controls.Add(Type:=msoControlButton)
With Przycisk_menu
.Caption = "Komunikat 1"
.FaceId = 266
.OnAction = "Makro_K1"
End With

'Druga pozycja menu
Set Przycisk_menu = Nowe_Menu.Controls.Add(Type:=msoControlPopup)
With Przycisk_menu
.Caption = "Komunikat 2"
'.FaceId = 9678 uwaga - dla msocontrolPopup nie określa się FaceId
.BeginGroup = True 'Rozpoczęcie grupy
End With

'Pierwsza pozycja podmenu
Set Przycisk_podmenu = Przycisk_menu.Controls.Add(Type:=msoControlButton)
With Przycisk_podmenu
.Caption = "Przycisk podmenu 1"
.FaceId = 9406
.OnAction = "Makro_P1"
End With
'Druga pozycja podmenu
Set Przycisk_podmenu = Przycisk_menu.Controls.Add(Type:=msoControlButton)
With Przycisk_podmenu
.Caption = "Przycisk podmenu 2"
.FaceId = 9405
.OnAction = "Makro_P2"
End With

'Trzecia pozycja menu
Set Przycisk_menu = Nowe_Menu.Controls.Add(Type:=msoControlButton)
With Przycisk_menu
.Caption = "Komunikat 3"
.FaceId = 9678
.OnAction = "Makro_K3"
End With

End Sub

Sub Usun_menu()
On Error Resume Next
'Polecenie On Error zapobiega
'wyświetlaniu komunikatu o
'błędzie w przypadku gdy menu
'Cwiczenie zostało już usunięte
CommandBars(1).Controls("Cwiczenie").Delete
End Sub

Sub Makro_K1()
MsgBox ("Komunikat dla przycisku 1 rozwijanego menu")
End Sub

Sub Makro_P1()
MsgBox ("Komunikat dla przycisku 1 podmenu")
End Sub

Sub Makro_P2()
MsgBox ("Komunikat dla przycisku 2 podmenu")
End Sub

Sub Makro_K3()
MsgBox ("Komunikat dla przycisku 3 rozwijanego menu")
End Sub

Modyfikacja menu jest przydatną, ale jednocześnie przez swą atrakcyjność - często nadużywaną możliwością w tworzonych aplikacjach. Na podstawie doświadczenia z pisania własnych programów i na własny użytek opracowałem spis zasad, których staram się przestrzegać:

• stosuję modyfikowanie menu tylko w niektórych przypadkach. Jeżeli do programu tworzę własne menu unikam modyfikowania istniejącego (cała obsługa z formularzy, arkusze robocze ukryte przed użytkownikiem), jeżeli natomiast praca odbywa się bezpośrednio w arkuszach roboczych można dla niezbędnych funkcji rozszerzyć standardowe menu Excela. Przez niezbędne funkcje rozumiem te których Excel nie zawiera - otwieranie innych plików do nich na pewno nie należy,
• nie zastępuję całego menu, ani nie usuwam pasków 'Standardowe' i 'Formatowanie'. Użytkownik jest do nich przyzwyczajony i nie lubi zmian. Poza tym często pracujemy jednocześnie na kilku plikach Excela, więc tak znaczne modyfikacje menu są niewskazane. Zwiększenie wielkości obszaru roboczego nie uzasadnia kasowania pasków narzędzi,
• Bezwględnie przestrzegam zasady, że modyfikowane menu dostępne jest tylko w trakcie pracy programu. Wyjście z pliku w każdy możliwy sposób powinno kasować menu dodatkowe. Dobrym nawykiem jest stosowanie parametru 'Temporary:=True'. Z zadowalającym efektem stosowałem też obsługę zdarzeń dla aktywacji i dezaktywacji pliku tak by dodatkowe menu było dostępne tylko dla tego programu dla którego zostało stworzone, niezależnie od tego ile plików Excela jest jednocześnie używanych. Efekt jaki czasami widuje się w programach - zmodyfikowane całe menu, usunięte paski poleceń, a przy wyjściu nie przywrócony stan wyjściowy jest bardzo irytujący dla użytkowników,
• nie stosuję resetowania pasków poleceń - jeżeli użytkownik je dostosował do swoich potrzeb (wyciągając odpowiednie skróty) takie działanie odbiera jako niezasłużoną złośliwość losu.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Obraz przycisku FaceId KLIKNIJ by (roz)winąć

Obraz wyświetlany na pasku narzędzi określa właściwość FaceId. Jest to po prostu numer, który odpowiada za obraz przycisku. W Excelu 2003 w trybie dostosowywania pasków narzędzi wybranie polecenia 'Zmień obraz przycisku' spowoduje wyświetlenie krótkiej listy obrazów do wyboru. Można również określić własny obraz w prostym edytorze ikon. Poza obrazami dostępnymi w ten sposób jest wiele innych - w literaturze jest mowa o ponad piętnastu tysiącach numerów FaceId. Niektóre z nich reprezentują puste obrazy, a inne mogą się powtarzać dla kilku numerów. Właściwość FaceId jest używana przy aplikacjach zmieniających standardowe menu Excela (również dla wersji 2007, gdzie zmiany menu uzupełniają wstążkę o nową zakładkę 'Dodatki'). Przy swojej własnej pierwszej modyfikacji menu numer obrazu przycisku określałem metodą prób i błędów. Obecnie dotarłem do literatury, w której podane są procedury wyświetlające wszystkie dostępne obrazy przycisków. Poniżej przedstawiam dwa krótkie pliki z makrami wyświetlającymi wszystkie numery FaceId (z obrazami przycisków) dla Excela 2003 i 2007. Są one do ściągnięcia w dziale pliki wraz ze spakowanym wydrukiem w formacie .pdf wszystkich obrazów plików.
Więcej informacji o FaceId można znaleźć w bardziej zaawansowanej literaturze VBA np.
- J. Walkenbach "Excel 2003. Programowanie VBA" - z tej publikacji zaczerpnięty jest kod listingu 1
- Pr. zbiorowa "Excel 2007. Programowanie VBA" - z tej publikacji zaczerpnięty jest kod listingu 2
Książki prezentowane są na podstronie niniejszej witryny. Materiały dodatkowe do książek wydawnictwa Helion (pliki) są do ściągnięcia ze strony wydawnictwa.
W zakresie modyfikacji menu korzystałem również z książek pani Snarskiej oraz pani Korol (również przedstawiane na stronie), ale ze względu na zakres (podręcznik pani Snarskiej) jak i wiek (podręcznik pani Korol) tych publikacji materiał dotyczący wymienionego zakresu jest dużo uboższy. Modyfikacja menu jaką wykonywałem dla swoich programów na podstawie obu tych książek była dużo bardziej uciążliwa. Obecnie uzbrojony w bardziej zaawansowaną literaturę zamierzam uzupełnić swoją wiedzę w tym zakresie i opublikować na stronie materiał dotyczący modyfikacji menu.

Listing 1 dla Excela 2003 Kliknij, żeby (roz)winąć listing

Kod tworzy pasek narzędzi z 200 przyciskami. Oprócz tego zawiera listę rozwijaną, gdzie można określić, który zbiór przycisków jest wyświetlany. Początkowo są to obrazy o numerach FaceId 1-200. Drugi zbiór wyświetla obrazy o identyfikatorach 201-400 itd. Uruchomienie makra pod Excelem 2007 wywoła pasek 'Dodatki' gdzie będą widoczne te same zbiory, ale w postaci niewygodnej do wykorzystania. Dla Excela 2007 przeznaczony jest drugi listing.

Dim ButtonGroup As Long

Sub ShowFaceIDs()
Dim NewToolbar As CommandBar
Dim NewButton As CommandBarButton
Dim SetNum As CommandBarComboBox
Dim i As Integer

'Usunięcie istniejącego paska FaceIds jeżeli istnieje
On Error Resume Next
Application.CommandBars("FaceIds").Delete
On Error GoTo 0
ButtonGroup = 1

'Dodanie pustego paska narzędzi
Set NewToolbar = Application.CommandBars.Add _
(Name:="FaceIds", temporary:=True)
NewToolbar.Visible = True

'Dodanie 200 przycisków
For i = 1 To 200
Set NewButton = NewToolbar.Controls.Add _
(Type:=msoControlButton, ID:=2950)
Next i

'Dodanie rozwijanej listy
Set SetNum = NewToolbar.Controls.Add(Type:=msoControlDropdown)
For i = 1 To 18
SetNum.AddItem "Zbiór " & i
Next i
With SetNum
.ListIndex = ButtonGroup
.Caption = "Numer zestawu przycisków"
.OnAction = "NewButtons"
End With
NewToolbar.Width = 400

'Skonfigurowanie przycisków
Call NewButtons
End Sub

Sub NewButtons()
'Wyświetlanie przycisków na podstawie wybranego zbioru na rozwijanej liście
Dim i As Long
ButtonGroup = CommandBars("FaceIds").Controls("Numer zestawu przycisków").ListIndex

For i = 1 To 200
With CommandBars("FaceIds").Controls(i)
.FaceId = (ButtonGroup - 1) * 200 + i
.Caption = "FaceID = " & (ButtonGroup - 1) * 200 + i
.OnAction = "EmptySub"
End With
Next i
End Sub

Listing 2 dla Excela 2007 Kliknij, żeby (roz)winąć listing


Kod tworzy tymczasowy pasek narzędzi (cbr)do którego dodawana jest tymczasowa kontrolka (ctl). Pętla Do ...Loop kontynuuje działanie do czasu aż zabraknie prawidłowych wartości FaceId. Zwiększa również zmienną iwiersz, która reprezentuje liczbę wierszy w arkuszu. W każdym wierszu jest dziesięć kolumn. Po wykonaniu wszystkich operacji kod czyści tymczasowy pasek poleceń i kończy działanie.

'Zwraca True jeśli arkusz sht jest pusty
Function CzyArkuszPusty(sht As Object) As Boolean

'Jeśli sht jest arkuszem, zlicza nie puste komorki
If TypeName(sht) = "Worksheet" Then

If WorksheetFunction.CountA(sht.UsedRange) = 0 Then

CzyArkuszPusty = True
Exit Function

End If

End If

MsgBox "Proszę się upewnić, że aktywny arkusz jest pusty."

End Function

Sub Wymien_wszystkie_rysunki()

Dim iFaceId As Integer 'Śledzi bieżący FaceId
Dim iKolumna As Integer 'Śledzi bieżącą kolumnę w arkuszu
Dim iWiersz As Integer 'Śledzi bieżący wiersz w arkuszu
Dim ctl As CommandBarControl
Dim cbr As CommandBar

If Not CzyArkuszPusty(ActiveSheet) Then Exit Sub

'Obsługuje błędy i zamraża ekran
On Error GoTo Odzyskiwanie
Application.ScreenUpdating = False

'Tworzy tymczasowy pasek poleceń z pojedynczą kontrolką przycisku
'aby przechować ikonę przycisku do skopiowania do arkusza
Set cbr = CommandBars.Add(Position:=msoBarFloating, _
MenuBar:=False, _
Temporary:=True)
Set ctl = cbr.Controls.Add(Type:=msoControlButton, _
Temporary:=True)

iWiersz = 1

Do

For iKolumna = 1 To 10
iFaceId = iFaceId + 1
Application.StatusBar = "FaceID = " & iFaceId
'Określanie kontrolki przycisku na aktualny FaceId
ctl.FaceId = iFaceId
'Proba skopiowania biezacego obrazu przycisku do arkusza
ctl.CopyFace
ActiveSheet.Paste Cells(iWiersz, iKolumna + 1)
Cells(iWiersz, iKolumna).Value = iFaceId
Next iKolumna
iWiersz = iWiersz + 1

Loop

Odzyskiwanie:
If Err.Number = 1004 Then Resume Next

Application.StatusBar = False
cbr.Delete

End Sub

Użytkownikom Excela zainteresowanym modyfikacją menu przydatna jest lista obrazków możliwych do wyświetlenia przy przycisku menu. Grafiki te identyfikowane są właśnie przez numer FaceID. Punkt przedstawia możliwości uzyskania listy wszystkich dostępnych numerów dla Excela 2003 i 2007. W punkcie podano również pozycje literatury omawiające te zagadnienia.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Losowanie liczb w Excelu KLIKNIJ by (roz)winąć

Temat symulacji losowania liczb w Excelu był kilkakrotnie poszukiwany przez osoby odwiedzające moją stronę. Standardowo Excel posiada funkcje losującą w postaci "=LOS()". W komórce generowana jest liczba z zakresu 0 - 1, która podlega powtórnemu losowaniu przy każdej modyfikacji arkusza (Uwaga - w punkcie Funkcja własna w Excelu - argumenty, opis, przynależność opisana jest funkcja, której wynik losowania nie ulega przeliczaniu). Bardziej elegancki wydaje mi sie sposób prezentowany w tym punkcie opierający się na losowaniu liczb z poziomu VBA. Osobiście tylko raz wykorzystałem tę funkcję w swojej pracy zawodowej. Pozostałe zastosowania to raczej rozrywka. Pomysł algorytmu zaczerpnąłem z literatury przedstawianej na stronie tj. książki Michael Halvorson 'Microsoft Visual Basic 2005. Krok po kroku'. W pliku, który proponuję przycisk 'Losuj' powoduje wyświetlenie małego formularza użytkownika. Określamy zakres liczb losowanych (możliwe są trzy opcje: od 0 do 10, od 0 do 100 i od 0 do 1000) oraz określamy ile liczb ma zostać wylosowanych. Po określeniu parametrów losowe liczby wstawiane są w aktywnym arkuszu w kolumnie poczynając od komórki "B5". Sercem 'maszyny losującej' jest wiersz postaci:
- Liczba_losowa = Int(Rnd()*zakres_losowania)
Poszczególne funkcje tego polecenia to:
- Funkcja Rnd() tworzy losową liczbę z zakresu od 0 do 1 (ułamek),
- Funkcja Int zwraca liczbę całkowitą bedącą wynikiem mnożenia wylosowanej wartości przez liczbę 'zakres_losowania'.
 W zależności od zaznaczonej na formularzu opcji jest to 10, 100 lub 1000
Poszczególne (przykładowe) kroki tego kodu to:
a) Rnd() - wynik np. 0,7055475
b) Rnd()*10 - wynik 7,055475
c) Int(Rnd()*10) - wynik 7
Podana pozycja literatury zwraca jeszcze uwagę, że funkcja Rnd() daje w wyniku powtarzającą się sekwencję liczb (co ma umożliwiać testowanie kodu) i zaleca, by dla pełnego uwolnienia wyników losowania użyć funkcji Randomize, która wykorzystując zegar systemowy tworzy rzeczywiście losowy punkt startowy dla polecenia Rnd. Wykonywałem kiedyś ćwiczenie w Visual Basicu i uwaga ta była rzeczywiście uzasadniona. Dla VBA dla Excela nie zauważyłem powtarzalności losowania wyników i funkcji Randomize nie zastosowałem.
Przykładowy plik do ściągnięcia w dziale pliki.
Na zakończenie jeszcze listing zastosowanego w pliku formularza:

Kod formularza losującego Kliknij, żeby (roz)winąć listing

Private Sub CommandButton1_Click()

Dim Ilosc_liczb As Integer
Dim Zakres_liczb As Integer
Dim Losowa As Integer
Dim i As Integer
Dim Komunikat As Integer
Dim Komorka As Range

Arkusz1.Range("B5:B2000").ClearContents

On Error GoTo Bład:

Set Komorka = Arkusz1.Range("B5")
If OptionButton1.Value = True Then Zakres_liczb = 10
If OptionButton2.Value = True Then Zakres_liczb = 100
If OptionButton3.Value = True Then Zakres_liczb = 1000
Ilosc_liczb = TextBox1.Value

For i = 1 To Ilosc_liczb
Komorka.Value = Int(Rnd() * Zakres_liczb)
Set Komorka = Komorka.Offset(1, 0)
Next

Exit Sub

Bład:
Komunikat = MsgBox("Nieprawidłowy zakres danych", vbExclamation + vbOKOnly, "LOSOWANIE LICZB")
Arkusz1.Range("B5:B2000").ClearContents
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False
TextBox1.Value = "10"
CommandButton1.Enabled = False

End Sub

Private Sub OptionButton1_Click()
CommandButton1.Enabled = True
End Sub

Private Sub OptionButton2_Click()
CommandButton1.Enabled = True
End Sub

Private Sub OptionButton3_Click()
CommandButton1.Enabled = True
End Sub

Private Sub UserForm_Activate()
Arkusz1.Range("B5:B2000").ClearContents
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False
TextBox1.Value = "10"
CommandButton1.Enabled = False
End Sub

Private Sub UserForm_Initialize()
Arkusz1.Range("B5:B2000").ClearContents
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False
TextBox1.Value = "10"
CommandButton1.Enabled = False
End Sub


W punkcie przedstawiono możliwości generowania liczb losowych w oparciu o standardową funkcję Excela oraz z poziomu VBA w nieco bardziej eleganckim algorytmie podłączonym do odpowiedniego formularza. Ograniczeniem standardowej funkcji Excela jest fakt, że losowana liczba jest generowana przy każdej zmianie arkusza. Tej wady nie posiada przedstawiony algorytm. Sam rdzeń przykładu zaczerpnięty jest z jednej z pozycji literatury. Przykładowy plik do ściągnięcia w dziale pliki.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Ukrywanie formantów VBA w Excelu KLIKNIJ by (roz)winąć

Jedną z ciekawszych właściwości formantów używanych w Excelu jest 'Visible'.
Tytułem wyjaśnienia - w tym przykładzie stosuję kontrolki ActiveX. Dla Excela 2003 ten typ kontrolek znajduje się na pasku narzędzi 'Przybornik formantów'. Bardzo podobny zestaw kontrolek, ale niebędący kontrolkami ActiveX, znajduje się na pasku narzędzi 'Formularze'. Kontrolki ActiveX umieszczane są na warstwie rysunkowej arkusza (niewidoczna warstwa znajdująca się nad arkuszem, przechowująca obrazy, wykresy i inne obiekty). W Excelu 2007 opisane rodzaje kontrolek dostępne są z jednego formularza. Różnice między dwoma rodzajami kontrolek:
A) dla kontrolek ActiveX:
- dostępne rodzaje to CheckBox, TextBox, CommandButton, OptionButton, ListBox, ComboBox, ToggleButton, Spinbutton, ScrollBar, Label, Image, - makro przechowywane jest w module powiązanym z arkuszem,
- nazwa makra odpowiada nazwie kontrolki,
- możliwości dostosowania przy użyciu okna Properties,
- możliwość powiązania ze wszystkimi dostępnymi kontrolkami,
B) dla kontrolek Excela:
- dostępne rodzaje to CheckBox, Button, OptionButton, ListBox, DropDown(ComboBox), Spinner, ScrollBar, GroupBox (mniej niż w kontrolkach ActiveX),
- makro przechowywane jest w dowolnym standardowym module języka VBA,
- małe możliwości dostosowania,
- obsługa zdarzeń tylko dla Click i Change,
Edytor Visual Basica uruchomić można między innymi skrótem lewy Alt + F11. W edytorze właściwości danej kontrolki ustawiamy w oknie Properties. Jedną z właściwości dostępną dla praktycznie każdej kontrolki jest Visible, przybierające dwie wartości logiczne: 'True' i 'False'. Domyślną wartością jest True. Warto zauważyć, że na kontrolce niewidocznej można nadal przeprowadzać niektóre operacje np. zmieniać Value dla kontrolki TextBox lub Caption dla kontrolki Label. Niektóre jak np. SetFocus będą niedostępne. Właściwie używana właściwość Visible pomaga w zbudowaniu przyjaznego użytkownikowi arkusza roboczego czy formularza. Autor aplikacji ma możliwość sterowania ilością kontrolek, widocznych w danej chwili dla użytkownika. Warto przy tym zauważyć, że kontrolki mogą być usytuowane dokładnie w tym samym miejscu formularza np. pole tekstowe TextBox i etykieta Label. Standardowo widoczna jest kontrolka Label wyświetlająca dane (Label.Visible = True, TextBox.Visible = True), w trakcie wprowadzania danych następuje odwrócenie widoczności (Label.Visible = False, TextBoxVisible = True). Tego typu rozwiązanie, z dobrym skutkiem, przyjąłem np. w programie REJESTR WODOMIERZY dla formularza wprowadzania danych - dobrze widać jego działanie na prezentacji wideo. W załączonym przykładowym pliku zamieściłem kontrolkę CommandButton (pokazuje formularz, gdzie kliknięcie przycisku powoduje ustawienie jego własnej widoczności na False, a widoczności kontrolek Image i Label na True) oraz ToggleButton (użycie powoduje zmianę widoczności kontrolek OptionButton). Warto jeszcze zwrócić uwagę na odwołanie do właściwości kontrolek OptionButton spoza Arkusz1 - ich wywołanie z poziomu Module1 wymaga 'umiejscowienia' - nazwa kontrolki poprzedzona jest nazwą Arkusza, w którym kontrolka się znajduje (nie Caption, a Name - nazwa z numerem identyfikującym). Przykładowy plik do pobrania w dziale pliki, a poniżej listing.

Kod przykładu widoczności kontrolek Kliknij, żeby (roz)winąć listing

'----- ARKUSZ 1 -----'
Option Explicit

Private Sub CommandButton1_Click()
Call Pokaż_formularz 'UserForm7
End Sub

Private Sub ToggleButton1_Click()
If ToggleButton1.Value = True Then Call Pokaż 'makro z Module1
If ToggleButton1.Value = False Then Call Schowaj 'makro z Module1
End Sub

'----- MODULE 1 -----'
Option Explicit

Sub Pokaż_formularz()
UserForm7.Show
End Sub

Sub Pokaż()

Arkusz1.OptionButton1.Visible = True
Arkusz1.OptionButton1.Value = False
Arkusz1.OptionButton2.Visible = True
Arkusz1.OptionButton2.Value = False
Arkusz1.OptionButton3.Visible = True
Arkusz1.OptionButton3.Value = False

End Sub

Sub Schowaj()

Arkusz1.OptionButton1.Visible = False
Arkusz1.OptionButton1.Value = False
Arkusz1.OptionButton2.Visible = False
Arkusz1.OptionButton2.Value = False
Arkusz1.OptionButton3.Visible = False
Arkusz1.OptionButton3.Value = False

End Sub

'----- FORMULARZ USERFORM7 -----'
Private Sub CommandButton1_Click()

CommandButton1.Visible = False

Label2.Visible = True
Image1.Visible = True

End Sub

Private Sub UserForm_Activate()
Label2.Visible = False
Image1.Visible = False

End Sub

W punkcie przedstawiono jedną z ciekawszych własności kontrolek VBA jaką jest Visible. Kontrolki w zależności od działań użytkownika możemy ustaić jako niewidoczne co pozwala uprościć obsługę formularzy i programu. Niektóre tematy tej witryny, powiązane z przedstawianym to:

• Program VBA wygodny w użytkowaniu,
• Wygodny formularz VBA - właściwość Visible,
• Ukrywanie arkuszy roboczych programu - obsługa zdarzeń,

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Formant ComboBox w Excelu KLIKNIJ by (roz)winąć

Kontrolka ComboBox (Pole kombi) jest jedną z częściej używanych kontrolek Excela i VBA. W tym punkcie chciałbym naszkicować możliwości jej zastosowania na niewielkim przykładzie, który podzieliłem na część dotyczącą kontrolki Excela (nie ActiveX) i kontrolki ActiveX. Różnice między tymi dwoma rodzajami oraz możliwościami ich uzyskania w Excelu 2003 i Excelu 2007 w skrócie przedstawiłem w punkcie Ukrywanie formantów VBA w Excelu. Przykład jest do ściągnięcia w dziale pliki.

Na początek kontrolka Excela:
W komórkach B10 - B20 umieszczam ciągi znaków z nazwami firm, a w komórkach C10 - C20 ciągi znaków z numerami NIP. Celem arkusza jest stworzenie listy rozwijanej, która w określonych komórkach np. szablonu faktury VAT wstawi nazwę kontrahenta i jego numer NIP (z braku weny nazwy firm to 'Firma i numer kolejny', podobnie jak numer NIP ;) W przykładzie przyjąłem, że wstawienie dokonywane będzie w komórkach B26 i C26, ale to tylko kwestia umowy. Oczywiście lepiej, gdy lista kontrahentów pobierana jest z innego arkusza niż używany (np. arkusz 'Pomoc', a docelowym jest arkusz 'Faktura'). Nie zmieniałem nazw arkusza i nazw kontrolki (domyślna nazwa 'Rozwiń1' widoczna jest w obszarze nazwy komórki).

Z paska narzędzi 'Formularze' wybieram kontrolkę o nazwie 'Pole kombi' (kontrolki Excela w wersji 2003 określone są nazwami polskimi) i rysuję żądany kształt. Analogicznie postępujemy w przypadku Excela 2007. Wygląd i właściwości narysowanej kontrolki możemy określić między innymi z menu kontekstowego (prawym przyciskiem myszy na kontrolce).

Właściwości kontrolki dostępne są z menu kontekstowego, paska narzędzi 'Formularze' itp. W widocznej na załączonym zrzucie ekranu zakładce 'Formant' zaznaczamy:
- zakres wejściowy - jest to lista z nazwami, które będą widoczne po rozwinięciu ComboBox-a,
- łącze komórki - opcjonalnie. Przedstawia komórkę związaną z naszą listą, w której będzie ustawiany indeks elementu wybranego przez użytkownika (numer pozycji na liście). Indeks jest liczony od liczby 1. Komórka jest związana w obie strony tzn. wpisanie do niej wartości indeksu spowoduje wybranie na liście rozwijanej właściwej dla wpisu pozycji. Komórka związana jest często używana w przypadku kilku list powiązanych ze sobą np. mamy dwie listy jedną z nazwami firm, a drugą z numerami NIP, po wybraniu wartości z jednej listy oczekujemy wyselekcjonowania na drugiej liście właściwej wartości,
- linie rzutu - liczba linii widocznych po rozwinięciu listy (standardowo 8),
Pozostałe możliwości formatowania kontrolki pozostawiam do samodzielnego wypróbowania ;)

Pozostało opisanie co powinno się dziać po wybraniu z listy nazwy firmy. Po użyciu przycisku 'Edytuj kod programu' z paska narzędzi 'Formularze' przejdziemy do makra o nazwie 'Rozwiń1_Zmienianie' przechowywanego w Module 1.
Krótkie omówienie makra:
Zmienna 'numer' to numer wybranej z listy pozycji. Proszę zwrócić uwagę, że w tym ujęciu pierwsze wyświetlenie wartości zmiennej numer komendą MsgBox(numer) pokaże wartość 0. Dzieje się tak ponieważ przy zmianie wartości listy wartość indeksu wstawiana jest do wartości komórki związanej dopiero na końcu wykonania makra. Przykłady, które korzystają z tej wartości polegają w skrócie na wybraniu pozycji z listy i kliknięciu przycisku - dopiero makro pod przyciskiem realizuje wyszukanie na podstawie wartości indeksu. Ponieważ nie chciałem dodatkowej kontrolki 'CommandButton' wykonanie makra chciałem uzyskać przy zmianie wartości Pola kombi.
Pole kombi jest elementem kolekcji DropDowns. Do elementów kolekcji odwołujemy się poprzez podanie nazwy elementu (w tym wypadku 'Drop Down 1') i właściwości (w tym wypadku ListIndex tzn. wartość indeksu). Inną często stosowaną właściwością jest wartość 'Value' - odwołująca się do ciągu znaków wyselekcjonowanego na liście. Tak więc pod zmienną 'numer' przypisujemy uzyskaną w ten sposób wartość indeksu. Wyświetlenie wartości zmiennej drugą w listingu komendą MsgBox ma potwierdzić prawidłowość procedury.
W kolejnym kroku w oknie komunikatu wyświetlam ciąg znaków nazwy firmy i numeru NIP. Źródłem jest komórka związana, w odniesieniu do której makro odczytuje wartości (metoda Offset(wiersze,kolumny) powoduje pobranie wartości z komórki odległej od wskazanej w przykładzie tj. E9 o ilość wierszy równą zmiennej 'numer' i wskazaną ilość kolumn).

W ostatnim kroku odczytane wartości wstawiam do wskazanych komórek - przydatne np. w gotowym formularzu faktury. Nic nie stoi na przeszkodzie by odczytane wartości wstawiać do komórek aktualnie zaznaczonych (Selection).

Są to podstawowe informacje na temat kontrolki Pole kombi, ale pozwalają już nieco uprościć pracę wielu plików. Zainteresowanym poszerzeniem wiedzy polecam ksiażkę Makropolecenia w Excelu pani Snarskiej. Jest jedną z nielicznych, które omawiają kontrolki Excela (prezentowana na niniejszej stronie książka Walkenbacha skupia się tylko na kontrolkach ActiveX).

Teraz kontrolka ActiveX:
Z paska narzędzi 'Przybornik formantów' wybieram kontrolkę o nazwie 'Pole kombi' i rysuję żądany kształt. Analogicznie postępujemy w przypadku Excela 2007. Wygląd i właściwości narysowanej kontrolki możemy określić uruchamiając okno 'Właściwości - Properties'. Jest ich zdecydowanie więcej niż w przypadku kontrolek nie-ActiveX. Właściwości pozwalają określić wygląd kontrolki (kolory ramki, tła, czcionki itd.), 'zachowanie' kontrolki (wyrównanie tekstu, marginesy) itd. Chciałbym przedstawić pokrótce najważniejsze moim zdaniem właściwości ComboBox:
- Enabled - zablokowanie kontrolki. Przyjmuje wartości logiczne i pozwala zablokować widoczną na ekranie kontrolkę,
- LinkedCell - komórka powiązana (w przykładzie M9) - w odróżnieniu od kontrolki Excela w LinkedCell zapisywana jest wartość aktualnie wyświetlana w ComboBox, a nie wartość indeksu,
- ListFillRange - odpowiednik zakresu wejściowego dla kontrolki Excela, w przykładzie ustawiono wartość na 'Arkusz1!B10-B20'. Dla kontrolki ComboBox w formularzu UserForm odpowiednikiem jest 'RowSource',
- ListRows - ilość wierszy wyświetlana po rozwinięciu listy (standardowo 8),
- Style - bardzo przydatna właściwość. W aplikacjach, które napisałem niektórzy użytkownicy zamiast wybierać wartości z listy wpisują je z ręki, później dziwiąc się, że komputer nie chce wyszukać danej firmy. Ustawienia właściwości Style na '2 - fmStyleDropDownList' spowoduje, że lista rozwijana może przybierać tylko wartości z zakresu określonego właściwością 'ListFillRange' i użytkownik nie może nic wpisać do widocznej listy (próba wpisania powoduje rozwinięcie kontrolki). Wadą tego rozwiązania jest to, że trzeba robić obejścia by np. przy aktywacji arkusza w ComboBox wyświetlany był napis 'Wybierz firmę' lub podobny nie będący na zdefiniowanej liście,
- Visible - właściwość kontrolek omówiona dokładnie w innym punkcie tego działu.
Ważnym jest, że dla ComboBox ActiveX wartość indeksu liczona jest od -1. Programując tego typu kontrolkę, mamy dostęp do sporej ilości zdarzeń. W przykładzie przewidziano tylko zdarzenie Change, ale w pełnych aplikacjach potrzebnych jest kilka więcej np. przy samym zdarzeniu Change będzie problem jeżeli wybrana firma jest już wyświetlana (wartość listy się nie zmieni więc nie ma startera dla makropolecenia). W pliku Rejestr zakupów na taką okoliczność przewidziałem zdarzenie 'DblClick' - wygoda pliku jest satysfakcjonująca.
Poniżej przedstawiam makro z obiektu 'Arkusz1' - wyjaśnienie jest analogiczne do przykładu powyżej (dla kontrolki nie-Active-X).
Jeżeli chodzi o zmianę zawartości listy ComboBox wraz z sortowaniem alfabetycznym to książka Makropolecenia w Excelu pani Snarskiej zawiera przykład oparty o sortowanie Excela i właściwość 'CurrentRegion'. Sam przyzwyczaiłem się do realizacji tego zadania pętlą 'Do Loop Until' (jeżeli chodzi o sortowanie z poziomu VBA to również sortuję poleceniami Excela) - przykład pochodzący z jednego z programów prezentuję w artykule Lista rozwijana ComboBox w VBA - dostosowywanie zawartości.

Przykładowe makro dla ComboBox z omówieniem Kliknij, żeby (roz)winąć listing

Sub Rozwiń1_Zmienianie()

Dim numer As Integer
Dim Komunikat As Integer

numer = Worksheets("Arkusz1").Range("E10").Value
MsgBox (numer)

numer = Worksheets("Arkusz1").DropDowns("Drop Down 1").ListIndex

MsgBox (numer)

Komunikat = MsgBox("Dla Firmy o nazwie: " & Arkusz1.Range("E9").Offset(numer, -3).Value & Chr(10) & _
"Numer NIP to: " & Arkusz1.Range("E9").Offset(numer, -2).Value, vbInformation + vbOKOnly, "COMBOBOX - nie ActiveX")

Arkusz1.Range("B26").Value = Arkusz1.Range("E9").Offset(numer, -3).Value
Arkusz1.Range("C26").Value = Arkusz1.Range("E9").Offset(numer, -2).Value

End Sub

Przykładowe makro dla ComboBox z omówieniem Kliknij, żeby (roz)winąć listing

Private Sub ComboBox1_Change()

Dim numer As Integer
Dim Komunikat As Integer

numer = Worksheets("Arkusz1").Range("E10").Value
MsgBox (numer)

numer = Worksheets("Arkusz1").ComboBox1.ListIndex
MsgBox (numer)

Komunikat = MsgBox("Dla Firmy o nazwie: " & Arkusz1.Range("E9").Offset(numer + 1, -3).Value & Chr(10) & _
"Numer NIP to: " & Arkusz1.Range("E9").Offset(numer + 1, -2).Value, vbInformation + vbOKOnly, "COMBOBOX - ActiveX")

Arkusz1.Range("H26").Value = Arkusz1.Range("E9").Offset(numer + 1, -3).Value
Arkusz1.Range("I26").Value = Arkusz1.Range("E9").Offset(numer + 1, -2).Value
End Sub

W punkcie przedstawiono podstawowe zagadnienia związane z kontrolką Combobox - listą rozwijaną. Przedstawiono proste makra obsługujące tę kontrolkę zarówno w wersji Active-X jak i zwykłej. Przedstawiono spoósb formatowania kontrolki, ustawiania jej właściwości, definiowania zakresu komórek stanowiących wypełnienie listy oraz sposób na zablokowanie wprowadzania własnych wpisów do tej okna kontrolki. Pozostałe możliwości ustalania listy ComboBox omówione są przy okazji punktu związanego z kontrolką ListBox. Temat kontrolki ComboBox jest dość obszernie poruszony w punkcie Formanty ListBox i ComboBox w Excelu - sposób wypełniania listy.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Formanty ListBox i ComboBox w Excelu - sposób wypełniania listy KLIKNIJ by (roz)winąć

Punktem wyjścia do przygotowania niniejszego punktu był spis państw, z których w poszczególnych miesiącach następowały wejścia na niniejszą witrynę. Spis ten umieszczono w arkuszu, z którego poszczególne formularze z kontrolkami ListBox i ComboBox pobierają dane. I tak:
- w komórkach C5-C16 dane dla miesiąca kwietnia 2009,
- w komórkach C21-C39 dane dla miesiąca maja 2009,
- w komórkach C44-C65 dane dla miesiąca czerwca 2009,
- w komórkach C70-C93 dane dla miesiąca sierpnia 2009,
- w komórkach C98-C122 dane dla miesiąca września 2009,
- w komórkach C127-C151 dane dla miesiąca października 2009,
- w komórkach C156-C184 dane dla miesiąca listopada 2009,
- w komórkach C189-C212 dane dla miesiąca grudnia 2009
Do poszczególnych przycisków przypisano makro realizujące odpowiednie zadania opisane w tym punkcie polegające na pobieraniu danych z arkusza i wypełnianie nimi listy dwóch podstawowych kontrolek. Kolejno prezentowane są metody AddItem, RowSource oraz wypełnianie przez tablicę, przy czym oddzielnie stosuję wpisy unikatowe i wpisy wszystkie, a c zęść procedur uzupełniam o sortowanie bąbelkowe listy. W jednym z przypadków prezentuję wypełnianie listy kontrolek w zależności od zaznaczenia w ramkach (Frame) kontrolek pomocniczych CheckBox i OptionButton. Kontrolki ListBox i ComboBox zastosowane są jako elementy formularzy. W kolejnych punktach przedstawię, krótkie omówienie zastosowanych procedur, a na końcu punktu znajdują się listingi. Plik z omawianym przykładem jest do ściągnięcia w dziale pliki. Szerokie omówienie zastosowanych technik znajduje się w książkach dotyczących programowania - między innymi Walkenbacha (patrz dział 'Literatura VBA'). Wszystkie przedstawione przykłady są mojego autorstwa.

PRZYKŁAD 1 - FORMULARZ 1
WYPEŁNIANIE ZAWARTOŚCI KONTROLKI LISTBOX LISTĄ UNIKATOWYCH WARTOŚCI - METODA ADDITEM.
Makro uruchamia się dla zdarzenia aktywacji formularza. Najpierw w serii pętli For Each _ Next następuje wypełnienie zmiennej typu New Collection "Unikatowe". Zmienna ta jest wypełniana zamienioną na ciąg tekstowy zawartością komórki. Później następuje przypisanie elementów kolekcji "Unikatowe" do tablicy i sortowanie bąbelkowe zmiennej tablicowej. Na końcu w pętli For _ To _ Next metodą Additem następuje przypisanie elementów tablicy do zawartości kontrolki. W książce Walkenbacha znajduje się podobny przykład, ale bez fragmentu procedury odpowiadającego za sortowanie.
Kilka słów wyjaśnienia dotyczącego kolekcji:
Z praktycznego punktu widzenia kolekcja jest podobna do tablicy, może przechowywać dane różnych typów, elementy kolekcji numerowane są od 1, nie trzeba deklarować jej wielkości (pamięć rezerwowana jest dynamicznie). Kolekcje posiadają cztery metody - Add, Item, Remove oraz Count. Metoda Count wykorzystana w procedurze podaje ilość elementów (Item) kolekcji. Metody Remove nie ma potrzeby objaśniać. Składnia wykorzystywanej w procedurze metody Add jest następująca:
Nazwa_Kolekcji.Add Item [, Key] [, Before,] [, After]
gdzie:
Item - element dodawany do kolekcji,
Key - identyfikator przypisany do elementu, pozwalający odwoływać się do elementu,
Before, After - argumenty umożliwiające precyzyjne umieszczenie elementu wśród innych elementów znajdujących się już w kolekcji.
Najważniejszy w prezentowanych procedurach jest argument KEY. Musi on być koniecznie ciągiem tekstowym stąd instrukcja CStr() - i musi być niepowtarzalny w danej kolekcji. Powtórzenie tego elementu generuje błąd - stąd na początku procedury znajduje się polecenie ignorowania błędów On Error Resume Next.
Wykorzystanie kolekcji pozwala z wielu różnych zbiorów w prosty sposób utworzyć zbiór niepowtarzalnych elementów i z tych względów jest dość często stosowane w tego typu zadaniach.

PRZYKŁAD 2 - FORMULARZ 2
WYPEŁNIANIE ZAWARTOŚCI KONTROLKI COMBOBOX LISTĄ UNIKATOWYCH WARTOŚCI - METODA ADDITEM.

Makro uruchamia się dla zdarzenia aktywacji formularza. Procedura jest w zasadzie identyczna z prezentowaną w przykładzie 1 procedurą dla kontrolki ListBox.

PRZYKŁAD 3 - FORMULARZ 3
WYPEŁNIANIE ZAWARTOŚCI KONTROLEK COMBOBOX i LISTBOX LISTĄ WSZYSTKICH WARTOŚCI - METODA ADDITEM.

Makro uruchamia się dla zdarzenia aktywacji formularza. Najpierw w serii pętli For Each _ Next następuje wypełnienie zmiennej tablicowej. Zmienna ta jest wypełniana zamienioną na ciąg tekstowy zawartością komórki. Dla przypomnienia polecenie ReDim Preserve odpowiada za zmianę wymiarów tablicy z zachowaniem jej dotychczasowych wartości. Na końcu w pętli For _ To _ Next metodą Additem następuje przypisanie elementów tablicy do zawartości kontrolek.

PRZYKŁAD 4 - FORMULARZ 4
WYPEŁNIANIE ZAWARTOŚCI KONTROLEK LISTBOX I COMBOBOX LISTĄ WARTOŚCI METODĄ ADDITEM I WŁAŚCIWOŚCIĄ ROWSOURCE Z POWIĄZANIEM WYPEŁNIANEJ LISTY Z WARTOŚCIĄ KONTROLEK POMOCNICZYCH CHECKBOX I OPTIONBUTTON.

Makro uruchamia się dla zdarzenia kliknięcia kontrolki OptionButton lub CheckBox. Każda z tych kontrolek związana jest z danymi dla danego miesiąca. Kliknięcie OptionButton (jednocześnie w jednej ramce może być zaznaczona tylko jedna tego typu kontrolka) powoduje ustawienie właściwości RowSource kontrolki ListBox2. Kod tego polecenia jest bardzo prosty - najpierw czyszczenie dotychczasowej zawartości, później ustawienie nowej. Kliknięcie kontrolki CheckBox (jednocześnie w jednej ramce może być zaznaczona większa ilość kontrolek) powoduje dodanie lub ujęcie z listy zawartości kontrolki ListBox1 danych dla zadanego miesiąca. Operacja ta wykonywana jest przez makro z modułu (takie samo dla wszystkich kontrolek). Makro najpierw czyści zawartość kontrolki, później w zależności od konkretnych zaznaczeń kontrolek metodą Additem następuje dodanie zawartości konkretnych komórek do listy ListBox1.

PRZYKŁAD 5 - FORMULARZ 5
WYPEŁNIANIE ZAWARTOŚCI KONTROLEK COMBOBOX i LISTBOX LISTĄ WSZYSTKICH WARTOŚCI - WYPEŁNIANIE TABLICĄ.

Makro uruchamia się dla zdarzenia aktywacji formularza. Tworzenie tablicy jest identyczne jak w przykładzie 3. Jedyna zmiana polega na określeniu zawartości kontrolek jednym poleceniem na końcu procedury.

LISTING PRZYKŁAD 1 Kliknij, żeby (roz)winąć listing

Option Base 1

Private Sub UserForm_Activate()

Dim Wszystkie_komórki As Range
Dim Komórka As Range
Dim Unikatowe As New Collection

On Error Resume Next
For Each Komórka In Range("C5:C16") 'kwiecień 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C21:C39") 'maj 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C44:C65") 'czerwiec 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C70:C93") 'sierpień 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C98:C122") 'wrzesień 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C127:C151") 'październik 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C156:C184") 'listopad 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C189:C212") 'grudzień 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

On Error GoTo 0

'SORTOWANIE BĄBELKOWE POZYCJI W KOLEKCJI UNIKATOWE
Dim i As Long
Dim j As Long
Dim Tablica_sortowana() As String
Dim Tymczasowy As String
Dim Ilość_elementów As Long
Dim Pierwszy As Long
Dim Ostatni As Long

On Error GoTo 0

'Zamrożenie aktualizacji ekranu - przyspiesza działanie procedury
Application.ScreenUpdating = False

'Pobranie ilości elementów tablicy
Ilość_elementów = Unikatowe.Count

'Zmiana wielkości tablicy w zależności od ilości elementów
ReDim Tablica_sortowana(1 To Ilość_elementów)

'Wypełnienie tablicy
i = 1
For Each Item In Unikatowe
Tablica_sortowana(i) = Item
i = i + 1
Next

'Pobranie kolejno pierwszego i ostatniego elementu tablicy
Pierwszy = LBound(Tablica_sortowana)
Ostatni = UBound(Tablica_sortowana)

'Procedura sortowania bąbelkowego
For i = Pierwszy To Ostatni - 1
For j = i + 1 To Ostatni
If Tablica_sortowana(i) >= Tablica_sortowana(j) Then
Tymczasowy = Tablica_sortowana(j)
Tablica_sortowana(j) = Tablica_sortowana(i)
Tablica_sortowana(i) = Tymczasowy
End If
Next j
Next i

'Odmrożenie odświeżania ekranu
Application.ScreenUpdating = True
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

For i = 1 To Ilość_elementów
UserForm1.ListBox1.AddItem Tablica_sortowana(i)
Next

'Wyświetlanie liczby pozycji
UserForm1.Label1.Caption = "Unikatowych pozycji: " & Unikatowe.Count

End Sub

LISTING PRZYKŁAD 2 Kliknij, żeby (roz)winąć listing

Option Base 1

Private Sub UserForm_Activate()

Dim Wszystkie_komórki As Range
Dim Komórka As Range
Dim Unikatowe As New Collection

On Error Resume Next
For Each Komórka In Range("C5:C16") 'kwiecień 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C21:C39") 'maj 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C44:C65") 'czerwiec 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C70:C93") 'sierpień 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C98:C122") 'wrzesień 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C127:C151") 'październik 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C156:C184") 'listopad 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C189:C212") 'grudzień 2009
Unikatowe.Add Komórka.Value, CStr(Komórka.Value)
Next Komórka

On Error GoTo 0

'SORTOWANIE BĄBELKOWE POZYCJI W KOLEKCJI UNIKATOWE
Dim i As Long
Dim j As Long
Dim Tablica_sortowana() As String
Dim Tymczasowy As String
Dim Ilość_elementów As Long
Dim Pierwszy As Long
Dim Ostatni As Long

On Error GoTo 0

'Zamrożenie aktualizacji ekranu - przyspiesza działanie procedury
Application.ScreenUpdating = False

'Pobranie ilości elementów tablicy
Ilość_elementów = Unikatowe.Count

'Zmiana wielkości tablicy w zależności od podanej ilości elementów
ReDim Tablica_sortowana(1 To Ilość_elementów)

'Wypełnienie tablicy wartościami losowymi
i = 1
For Each Item In Unikatowe
Tablica_sortowana(i) = Item
i = i + 1
Next

'Pobranie kolejno pierwszego i ostatniego elementu tablicy
Pierwszy = LBound(Tablica_sortowana)
Ostatni = UBound(Tablica_sortowana)

'Procedura sortowania bąbelkowego
For i = Pierwszy To Ostatni - 1
For j = i + 1 To Ostatni
If Tablica_sortowana(i) >= Tablica_sortowana(j) Then
Tymczasowy = Tablica_sortowana(j)
Tablica_sortowana(j) = Tablica_sortowana(i)
Tablica_sortowana(i) = Tymczasowy
End If
Next j
Next i

'Odmrożenie odświeżania ekranu
Application.ScreenUpdating = True
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

For i = 1 To Ilość_elementów
UserForm2.ComboBox1.AddItem Tablica_sortowana(i)
Next

'Wyświetlanie liczby pozycji
UserForm2.Label1.Caption = "Unikatowych pozycji: " & Unikatowe.Count

End Sub

LISTING PRZYKŁAD 3 Kliknij, żeby (roz)winąć listing

Option Base 1

Private Sub UserForm_Activate()

Dim Wszystkie_komórki As Range
Dim Komórka As Range
Dim Tablica() As String
Dim i As Long
Dim j As Long
Dim Ilość_elementów As Long

On Error Resume Next
i = 0
Ilość_elementów = 0

For Each Komórka In Range("C5:C16") 'kwiecień 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C21:C39") 'maj 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C44:C65") 'czerwiec 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C70:C93") 'sierpień 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C98:C122") 'wrzesień 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C127:C151") 'październik 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C156:C184") 'listopad 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C189:C212") 'grudzień 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For i = 1 To Ilość_elementów
UserForm3.ListBox1.AddItem Tablica(i)
UserForm3.ComboBox1.AddItem Tablica(i)
Next

'Wyświetlanie liczby pozycji
UserForm3.Label1.Caption = "Wszystkich pozycji: " & Ilość_elementów

End Sub

LISTING PRZYKŁAD 4 Kliknij, żeby (roz)winąć listing

Private Sub CheckBox1_Click()
Call CheckBoxy_Formularza4
End Sub

Private Sub CheckBox2_Click()
Call CheckBoxy_Formularza4
End Sub

Private Sub CheckBox3_Click()
Call CheckBoxy_Formularza4
End Sub

Private Sub CheckBox4_Click()
Call CheckBoxy_Formularza4
End Sub

Private Sub CheckBox5_Click()
Call CheckBoxy_Formularza4
End Sub

Private Sub CheckBox6_Click()
Call CheckBoxy_Formularza4
End Sub

Private Sub CheckBox7_Click()
Call CheckBoxy_Formularza4
End Sub

Private Sub CheckBox8_Click()
Call CheckBoxy_Formularza4
End Sub

Private Sub OptionButton1_Click()
UserForm4.ListBox2.RowSource = "Arkusz1!A1" 'kwiecień
UserForm4.ListBox2.RowSource = ""
UserForm4.ListBox2.RowSource = "Arkusz1!C5:C16"
End Sub

Private Sub OptionButton2_Click()
UserForm4.ListBox2.RowSource = "Arkusz1!A1" 'maj
UserForm4.ListBox2.RowSource = ""
UserForm4.ListBox2.RowSource = "Arkusz1!C21:C39"
End Sub

Private Sub OptionButton3_Click()
UserForm4.ListBox2.RowSource = "Arkusz1!A1" 'czerwiec
UserForm4.ListBox2.RowSource = ""
UserForm4.ListBox2.RowSource = "Arkusz1!C44:C65"
End Sub

Private Sub OptionButton4_Click()
UserForm4.ListBox2.RowSource = "Arkusz1!A1" 'sierpień
UserForm4.ListBox2.RowSource = ""
UserForm4.ListBox2.RowSource = "Arkusz1!C70:C93"
End Sub

Private Sub OptionButton5_Click()
UserForm4.ListBox2.RowSource = "Arkusz1!A1" 'wrzesień
UserForm4.ListBox2.RowSource = ""
UserForm4.ListBox2.RowSource = "Arkusz1!C98:C122"
End Sub

Private Sub OptionButton6_Click()
UserForm4.ListBox2.RowSource = "Arkusz1!A1" 'październik
UserForm4.ListBox2.RowSource = ""
UserForm4.ListBox2.RowSource = "Arkusz1!C127:C151"
End Sub

Private Sub OptionButton7_Click()
UserForm4.ListBox2.RowSource = "Arkusz1!A1" 'listopad
UserForm4.ListBox2.RowSource = ""
UserForm4.ListBox2.RowSource = "Arkusz1!C156:C184"
End Sub

Private Sub OptionButton8_Click()
UserForm4.ListBox2.RowSource = "Arkusz1!A1" 'grudzień
UserForm4.ListBox2.RowSource = ""
UserForm4.ListBox2.RowSource = "Arkusz1!C189:C212"
End Sub

Sub CheckBoxy_Formularza4()

'Wyczyszczenie zawartości ListBox'a
UserForm4.ListBox1.RowSource = "Arkusz1!A1"
UserForm4.ListBox1.RowSource = ""
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

If UserForm4.CheckBox1.Value = True Then 'kwiecień
With UserForm4.ListBox1
.AddItem Arkusz1.Range("C5").Value
.AddItem Arkusz1.Range("C6").Value
.AddItem Arkusz1.Range("C7").Value
.AddItem Arkusz1.Range("C8").Value
.AddItem Arkusz1.Range("C9").Value
.AddItem Arkusz1.Range("C10").Value
.AddItem Arkusz1.Range("C11").Value
.AddItem Arkusz1.Range("C12").Value
.AddItem Arkusz1.Range("C13").Value
.AddItem Arkusz1.Range("C14").Value
.AddItem Arkusz1.Range("C15").Value
.AddItem Arkusz1.Range("C16").Value
End With
End If

If UserForm4.CheckBox2.Value = True Then 'maj
With UserForm4.ListBox1
.AddItem Arkusz1.Range("C21").Value
.AddItem Arkusz1.Range("C22").Value
.AddItem Arkusz1.Range("C23").Value
.AddItem Arkusz1.Range("C24").Value
.AddItem Arkusz1.Range("C25").Value
.AddItem Arkusz1.Range("C26").Value
.AddItem Arkusz1.Range("C27").Value
.AddItem Arkusz1.Range("C28").Value
.AddItem Arkusz1.Range("C29").Value
.AddItem Arkusz1.Range("C30").Value
.AddItem Arkusz1.Range("C31").Value
.AddItem Arkusz1.Range("C32").Value
.AddItem Arkusz1.Range("C33").Value
.AddItem Arkusz1.Range("C34").Value
.AddItem Arkusz1.Range("C35").Value
.AddItem Arkusz1.Range("C36").Value
.AddItem Arkusz1.Range("C37").Value
.AddItem Arkusz1.Range("C38").Value
.AddItem Arkusz1.Range("C39").Value
End With
End If

If UserForm4.CheckBox3.Value = True Then 'czerwiec
With UserForm4.ListBox1
.AddItem Arkusz1.Range("C44").Value
.AddItem Arkusz1.Range("C45").Value
.AddItem Arkusz1.Range("C46").Value
.AddItem Arkusz1.Range("C47").Value
.AddItem Arkusz1.Range("C48").Value
.AddItem Arkusz1.Range("C49").Value
.AddItem Arkusz1.Range("C50").Value
.AddItem Arkusz1.Range("C51").Value
.AddItem Arkusz1.Range("C52").Value
.AddItem Arkusz1.Range("C53").Value
.AddItem Arkusz1.Range("C54").Value
.AddItem Arkusz1.Range("C55").Value
.AddItem Arkusz1.Range("C56").Value
.AddItem Arkusz1.Range("C57").Value
.AddItem Arkusz1.Range("C58").Value
.AddItem Arkusz1.Range("C59").Value
.AddItem Arkusz1.Range("C60").Value
.AddItem Arkusz1.Range("C61").Value
.AddItem Arkusz1.Range("C62").Value
.AddItem Arkusz1.Range("C63").Value
.AddItem Arkusz1.Range("C64").Value
.AddItem Arkusz1.Range("C65").Value
End With
End If

If UserForm4.CheckBox4.Value = True Then 'sierpień
With UserForm4.ListBox1
.AddItem Arkusz1.Range("C70").Value
.AddItem Arkusz1.Range("C71").Value
.AddItem Arkusz1.Range("C72").Value
.AddItem Arkusz1.Range("C73").Value
.AddItem Arkusz1.Range("C74").Value
.AddItem Arkusz1.Range("C75").Value
.AddItem Arkusz1.Range("C76").Value
.AddItem Arkusz1.Range("C77").Value
.AddItem Arkusz1.Range("C78").Value
.AddItem Arkusz1.Range("C79").Value
.AddItem Arkusz1.Range("C80").Value
.AddItem Arkusz1.Range("C81").Value
.AddItem Arkusz1.Range("C82").Value
.AddItem Arkusz1.Range("C83").Value
.AddItem Arkusz1.Range("C84").Value
.AddItem Arkusz1.Range("C85").Value
.AddItem Arkusz1.Range("C86").Value
.AddItem Arkusz1.Range("C87").Value
.AddItem Arkusz1.Range("C88").Value
.AddItem Arkusz1.Range("C89").Value
.AddItem Arkusz1.Range("C90").Value
.AddItem Arkusz1.Range("C91").Value
.AddItem Arkusz1.Range("C92").Value
.AddItem Arkusz1.Range("C93").Value
End With
End If

If UserForm4.CheckBox5.Value = True Then 'wrzesień
With UserForm4.ListBox1
.AddItem Arkusz1.Range("C98").Value
.AddItem Arkusz1.Range("C99").Value
.AddItem Arkusz1.Range("C100").Value
.AddItem Arkusz1.Range("C101").Value
.AddItem Arkusz1.Range("C102").Value
.AddItem Arkusz1.Range("C103").Value
.AddItem Arkusz1.Range("C104").Value
.AddItem Arkusz1.Range("C105").Value
.AddItem Arkusz1.Range("C106").Value
.AddItem Arkusz1.Range("C107").Value
.AddItem Arkusz1.Range("C108").Value
.AddItem Arkusz1.Range("C109").Value
.AddItem Arkusz1.Range("C110").Value
.AddItem Arkusz1.Range("C111").Value
.AddItem Arkusz1.Range("C112").Value
.AddItem Arkusz1.Range("C113").Value
.AddItem Arkusz1.Range("C114").Value
.AddItem Arkusz1.Range("C115").Value
.AddItem Arkusz1.Range("C116").Value
.AddItem Arkusz1.Range("C117").Value
.AddItem Arkusz1.Range("C118").Value
.AddItem Arkusz1.Range("C119").Value
.AddItem Arkusz1.Range("C120").Value
.AddItem Arkusz1.Range("C121").Value
.AddItem Arkusz1.Range("C122").Value
End With
End If

If UserForm4.CheckBox6.Value = True Then 'październik
With UserForm4.ListBox1
.AddItem Arkusz1.Range("C127").Value
.AddItem Arkusz1.Range("C128").Value
.AddItem Arkusz1.Range("C129").Value
.AddItem Arkusz1.Range("C130").Value
.AddItem Arkusz1.Range("C131").Value
.AddItem Arkusz1.Range("C132").Value
.AddItem Arkusz1.Range("C133").Value
.AddItem Arkusz1.Range("C134").Value
.AddItem Arkusz1.Range("C135").Value
.AddItem Arkusz1.Range("C136").Value
.AddItem Arkusz1.Range("C137").Value
.AddItem Arkusz1.Range("C138").Value
.AddItem Arkusz1.Range("C139").Value
.AddItem Arkusz1.Range("C140").Value
.AddItem Arkusz1.Range("C141").Value
.AddItem Arkusz1.Range("C142").Value
.AddItem Arkusz1.Range("C143").Value
.AddItem Arkusz1.Range("C144").Value
.AddItem Arkusz1.Range("C145").Value
.AddItem Arkusz1.Range("C146").Value
.AddItem Arkusz1.Range("C147").Value
.AddItem Arkusz1.Range("C148").Value
.AddItem Arkusz1.Range("C149").Value
.AddItem Arkusz1.Range("C150").Value
.AddItem Arkusz1.Range("C151").Value
End With
End If

If UserForm4.CheckBox7.Value = True Then 'listopad
With UserForm4.ListBox1
.AddItem Arkusz1.Range("C156").Value
.AddItem Arkusz1.Range("C157").Value
.AddItem Arkusz1.Range("C158").Value
.AddItem Arkusz1.Range("C159").Value
.AddItem Arkusz1.Range("C160").Value
.AddItem Arkusz1.Range("C161").Value
.AddItem Arkusz1.Range("C162").Value
.AddItem Arkusz1.Range("C163").Value
.AddItem Arkusz1.Range("C164").Value
.AddItem Arkusz1.Range("C165").Value
.AddItem Arkusz1.Range("C166").Value
.AddItem Arkusz1.Range("C167").Value
.AddItem Arkusz1.Range("C168").Value
.AddItem Arkusz1.Range("C169").Value
.AddItem Arkusz1.Range("C170").Value
.AddItem Arkusz1.Range("C171").Value
.AddItem Arkusz1.Range("C172").Value
.AddItem Arkusz1.Range("C173").Value
.AddItem Arkusz1.Range("C174").Value
.AddItem Arkusz1.Range("C175").Value
.AddItem Arkusz1.Range("C176").Value
.AddItem Arkusz1.Range("C177").Value
.AddItem Arkusz1.Range("C178").Value
.AddItem Arkusz1.Range("C179").Value
.AddItem Arkusz1.Range("C180").Value
.AddItem Arkusz1.Range("C181").Value
.AddItem Arkusz1.Range("C182").Value
.AddItem Arkusz1.Range("C183").Value
.AddItem Arkusz1.Range("C184").Value
End With
End If

If UserForm4.CheckBox8.Value = True Then 'grudzień
With UserForm4.ListBox1
.AddItem Arkusz1.Range("C189").Value
.AddItem Arkusz1.Range("C190").Value
.AddItem Arkusz1.Range("C191").Value
.AddItem Arkusz1.Range("C192").Value
.AddItem Arkusz1.Range("C193").Value
.AddItem Arkusz1.Range("C194").Value
.AddItem Arkusz1.Range("C195").Value
.AddItem Arkusz1.Range("C196").Value
.AddItem Arkusz1.Range("C197").Value
.AddItem Arkusz1.Range("C198").Value
.AddItem Arkusz1.Range("C199").Value
.AddItem Arkusz1.Range("C200").Value
.AddItem Arkusz1.Range("C201").Value
.AddItem Arkusz1.Range("C202").Value
.AddItem Arkusz1.Range("C203").Value
.AddItem Arkusz1.Range("C204").Value
.AddItem Arkusz1.Range("C205").Value
.AddItem Arkusz1.Range("C206").Value
.AddItem Arkusz1.Range("C207").Value
.AddItem Arkusz1.Range("C208").Value
.AddItem Arkusz1.Range("C209").Value
.AddItem Arkusz1.Range("C210").Value
.AddItem Arkusz1.Range("C211").Value
.AddItem Arkusz1.Range("C212").Value
End With
End If

End Sub

LISTING PRZYKŁAD 5 Kliknij, żeby (roz)winąć listing

Option Base 1

Private Sub UserForm_Activate()

Dim Wszystkie_komórki As Range
Dim Komórka As Range
Dim Tablica() As String
Dim i As Long
Dim Ilość_elementów As Long

On Error Resume Next
i = 0
Ilość_elementów = 0

For Each Komórka In Range("C5:C16") 'kwiecień 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C21:C39") 'maj 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C44:C65") 'czerwiec 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C70:C93") 'sierpień 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C98:C122") 'wrzesień 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C127:C151") 'październik 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C156:C184") 'listopad 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

For Each Komórka In Range("C189:C212") 'grudzień 2009
i = i + 1
Ilość_elementów = Ilość_elementów + 1
ReDim Preserve Tablica(1 To Ilość_elementów)
Tablica(i) = CStr(Komórka.Value)
Next Komórka

UserForm5.ListBox1.List = Tablica
UserForm5.ComboBox1.List = Tablica

End Sub

W punkcie omówiono sposób wypełnienia zawartości kontrolek ListBox i ComboBox następującymi metodami:
- określenia adresu zakresu dla właściwości RowSource,
- wypełnienia zawartości listy tablicą,
- wypełnienia zawartości listy z wykorzystaniem metody AddItem,
- wypełnienie zawartości listy unikatowych pozycji z listy (przesortowanych)
Dla wykonania listy niepowtarzających się wartości wykorzystano deklarowanie tzw. kolekcji.
Stosowaną wcześniej przeze mnie metodę wypełniania listy zakresem z podaniem właściwości RowSource przy rozszerzanym zakresie źródłowym podałem między innymi w punkcie działu 'Programy od kuchni' Lista rozwijana ComboBox w VBA - dostosowywanie zawartości. Podstawowe informacje dotyczące kontrolki ComboBox podałem w punkcie Formant ComboBox w Excelu. Załącznikiem punktu jest przykładowy plik (w dziale download), którego poszczególne formularze zawierają kontrolki wypełniane z wykorzystaniem podanych wyżej sposobów. W pliku w poszczególnych zakresach komórek arkusza 1 zawarłem spis państw z których internauci wchodzili na niniejszą witrynę w poszczególnych miesiącach.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Dni tygodnia i data wielkanocy KLIKNIJ by (roz)winąć

Jednym z pytań zadawanych na stronie jest możliwość wykorzystania Excela do rozpoznawania dni tygodnia i dat świąt ruchomych. Jeżeli chodzi o dni tygodnia to arkusz kalkulacyjny Excel ma tę funkcję wbudowaną w standardzie i nie ma potrzeby zaprzęgać do tego zadania makr. W grupie funkcji 'Daty i czasu' znajduje się funkcja postaci '=DZIEŃ.TYG(data lub adres komórki z datą)'. Wynikiem działania tej funkcji jest liczba w zakresie od 1 do 7 określająca dzień tygodnia przy czym 1 to niedziela, 2 to poniedziałek itd. Jeżeli nie odpowiada nam ten zapis to bardzo prosto np. funkcją 'Jeżeli' możemy uzyskać bardziej tradycyjny zapis słowny tzn. 'poniedziałek', 'wtorek' itd. Funkcja 'Jeżeli' ma postać '=JEŻELI(Warunek logiczny; 'Wartość jeżeli spełniony'; 'Wartość jeżeli niespełniony'). Dodatkowo funkcja ta może zostać do siedmiu razy zagnieżdżona tzn. zamiast jednego z zapisów dla warunku spełnionego lub niespełnionego możemy dać kolejną funkcję 'Jeżeli'. Dla omawianego przykładu oznacza to, że funkcja zamieniająca zapis liczbowy dnia tygodnia w zapis słowny ma postać:
'=JEŻELI(D6=1;"Niedziela";JEŻELI(D6=2;"Poniedziałek";JEŻELI(D6=3;"Wtorek";JEŻELI(D6=4;"Środa";JEŻELI(D6=5;"Czwartek";JEŻELI(D6=6;"Piątek";"Sobota"))))))'
Nie jest to może najbardziej finezyjny czy jedyny sposób realizacji zadania rozpoznania dnia tygodnia po dacie, ale swoją funkcję spełni. Jeżeli dodatkowo zastosujemy autoformatowanie to możemy wybrane dni tygodnia oznaczyć różnymi kolorami. Wszystkie omawiane w tym podpunkcie funkcje omówione zostaną również w dziale Porady Excel.
Więcej informacji o zastosowaniu funkcji Jeżeli zawarłem na podstronie 'Porady Excel' w punkcie: Funkcja Jeżeli, Lub, Oraz.
Jeżeli chodzi o sposób wyznaczania daty świąt to sprawa jest prosta dla świąt stałych. Dla świąt ruchomych będzi prosta o ile mamy sposób na wyzanczenie daty świąt wielkanocy. Pozostałe święta ruchome wyznaczane są w odniesieniu od tej daty:
- Boże Ciało - przypada 60 dni po Wielkanocy,
- Niedziela Palmowa - przypada 7 dni przed Wielkanocą,
- Wielki Czwartek - przypada 3 dni przed Wielkanocą,
- Wielki Piatek - przypada 2 dni przed Wielkanocą,
- Święto Miłosierdzia Bożego - przypada 7 dni po Wielkanocy,
- Wniebowstąpienie - w Polsce od 2004 roku przypada 43 dni po Wielkanocy,
- Zesłanie Ducha Świętego - przypada 49 dni po Wielkanocy,
Cały problem to znalezienie daty święta ruchomego Wielkanocy. Ten problem pod kątem algorytmu rozwiązał już pan Gauss (ten od krzywej swego imienia, sumy wyrazów ciągu arytmetycznego i całej masy innych wzorów matematycznych ;) Funkcja określona na podstawie tego algorytmu pozwala na wyznaczenie daty Wielkanocy dla lat 1900 - 2199 (o następne lata na razie nie bedziemy się martwić). Funkcja tego typu została wprowadzona do przykładu dla tego artykułu, który załączam w dziale pliki, listing w punkcie Definicja funkcji własnej.

W punkcie przedstawiono sposób na określenie dnia tygodnia na podstawie daty dla Excela oraz sposób na wyznaczenia daty świąt wielkanocnych. Do artykułu dołączony jest plik Wielkanoc_i_dni_tygodnia w dziale pliki. Niektóre tematy tej witryny, powiązane z przedstawianym to:

• Definicja funkcji własnej - omawia zastosowanie funkcji wyznaczania daty Wielkanocy,
• S. Flanczewski 'Excel z elementami VBA w firmie' - nie tylko omawia uzyskanie przedstawianej funkcji, ale również zastosowanie jej jako dodatku Excela dostępnego dla wszystkich plików danego komputera - polecam,
• Lista obecności na Os. Rusa - praktyczne zastosowanie omawianego materiału. Dostępny jest również plik wolny tzn. nie powiązany z moim własnym miejscem pracy.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Funkcja własna w Excelu argumenty, opis, przynależność KLIKNIJ by (roz)winąć

Funkcja własna w Excelu może nie posiadać żadnych, argumentów, a może ich mieć nieokreśloną ilość, przy czym część z nich to mogą być argumenty opcjonalne. W poniższych przykładach przedstawiam kilka z możliwości definicji argumentów. Przykłady są częściowo wzorowane na podręczniku Walkenbacha prezentowanym na niniejszej witrynie.

Funkcja pozbawiona argumentów
Function Stały_Los ()
'zwraca losową wartość, która nie jest zmieniana po ponowieniu obliczeń
Stały_Los = Rnd()
End Function

Generowanie losowych liczb całkowitych z przedziału 0-1000:
= INT(Stały_Los()*1000)

Funkcja z jednym argumentem
Funkcja oblicza prowizję ze sprzedaży, która zależna jest od kwoty sprzedaży. W trzech stałych definiowane są progi procentowe, a w konstrukcji Select Case w zależności od wartości sprzedaży obliczana jest prowizja z zastosowaniem jednego z trzech progów.

Function Prowizja(Wartość_sprzedaży)
Const Próg_1 = 0,08
Const Próg_2 = 0,10
Const Próg_3 = 0,12
'Oblicza prowizję zależną od wartości sprzedaży
Selekt Case Wartość_sprzedaży
Case 0 To 9999.99: Prowizja = Wartość_sprzedaży*Próg_1
Case 10000 To 19999.99: Prowizja = Wartość_sprzedaży*Próg_2
Case >=20000: Prowizja = Wartość_sprzedaży*Próg_3
End Select
End Function

Funkcja z dwoma argumentami
Funkcja jak poprzednio, ale tutaj prowizja zależna jest od kwoty sprzedaży i od lat pracy. Function Prowizja(Wartość_sprzedaży, Lata_pracy)

Const Próg_1 = 0,08
Const Próg_2 = 0,10
Const Próg_3 = 0,12
'Oblicza prowizję zależną od wartości sprzedaży
Selekt Case Wartość_sprzedaży
Case 0 To 9999.99: Prowizja = Wartość_sprzedaży*Próg_1
Case 10000 To 19999.99: Prowizja = Wartość_sprzedaży*Próg_2
Case >=20000: Prowizja = Wartość_sprzedaży*Próg_3
End Select
Wartość_sprzedaży = Wartość_sprzedaży + (Wartość_sprzedaży * Lata_pracy/100)
End Function

Funkcja używająca opcjonalnych argumentów
Należy przed nazwą zmiennej użyć instrukcji Optional i umieścić argumenty opcjonalne za wymaganymi.

Funkcja jak poprzednio, ale w niej zmienna Lata_pracy jest opcjonalna - jeśli nie zostanie podana program przyjmie jej wartość na zdefiniowanym w procedurze poziomie.

Function Prowizja(Wartość_sprzedaży, Optional Lata_pracy As Integer)
Const Próg_1 = 0,08
Const Próg_2 = 0,10
Const Próg_3 = 0,12
If Lata_pracy = "" Then Lata_pracy = 0
'Oblicza prowizję zależną od wartości sprzedaży
Selekt Case Wartość_sprzedaży
Case 0 To 9999.99: Prowizja = Wartość_sprzedaży*Próg_1
Case 10000 To 19999.99: Prowizja = Wartość_sprzedaży*Próg_2
Case >=20000: Prowizja = Wartość_sprzedaży*Próg_3
End Select
Wartość_sprzedaży = Wartość_sprzedaży + (Wartość_sprzedaży * Lata_pracy/100)
End Function

Wprowadzanie funkcji do określonej grupy
Domyślnie funkcje niestandardowe umieszczane są w kategorii "Użytkownika". Jeśli chcemy zmienić przynależność do danej kategorii stosujemy instrukcję:
Application.MacroOptions Macro:="Nazwa_funkcji", Category:=1
Lista dostępnych wartości:
- numer kategorii 0 Nazwa kategorii: Wszystkie (żadna konkretna)
- numer kategorii 1 Nazwa kategorii: Finansowe
- numer kategorii 2 Nazwa kategorii: Daty i czasu
- numer kategorii 3 Nazwa kategorii: Matematyczne
- numer kategorii 4 Nazwa kategorii: Statystyczne
- numer kategorii 5 Nazwa kategorii: Wyszukiwania i adresu
- numer kategorii 6 Nazwa kategorii: Bazy danych
- numer kategorii 7 Nazwa kategorii: Tekstowe
- numer kategorii 8 Nazwa kategorii: Logiczne
- numer kategorii 9 Nazwa kategorii: Informacyjne
- numer kategorii 10 Nazwa kategorii: Polecenia
- numer kategorii 11 Nazwa kategorii: Dostosowywanie
- numer kategorii 12 Nazwa kategorii: Sterowanie makrami
- numer kategorii 13 Nazwa kategorii: DDE/Zewnętrzne
- numer kategorii 14 Nazwa kategorii: Użytkownika

Definiowanie opisu funkcji
W kodzie źródłowym VBA za pomocą instrukcji:
Application.MacroOptions Macro:= "Nazwa_funkcji", _
Description:= "Opis działania funkcji"

Ręczne wprowadzanie opisu - w oknie dialogowym makro wprowadzić nazwę funkcji (standardowo nazwy funkcji nie są widoczne)i użyć przycisku opcje. W widocznym oknie można wprowadzać opis funkcji:

Używamy przycisku jak do uruchamiania ręcznego makr. Funkcji własnej tutaj nie ma, ale ...

... możemy wprowadzić jej nazwę ręcznie i wybrać przycisk opcje

w wyświetlonym oknie można wprowadzić opis funkcji. Będzie on widoczny po wybraniu funkcji z odpowiedniej listy. Uwaga: niektóre wersje Excela nie rozpoznają w tym miejscu polskich znaków. Należy pamiętać również, że opis funkcji nie może być zbyt długi - to tylko podpowiedź, a nie plik pomocy.

W punkcie przedstawiono nieco bardziej zaawansowany materiał dotyczący tworzenia własnej funkcji użytkownika. Podano sposób wprowadzania argumentów (w tym opcjonalnych), wprowadzania opisu funkcji, a także określenia przynależności funkcji do jednego z działów Excela (np. funkcje finansowe, matematyczne, tekstowe itp.). Materiał obrazowany jest przykładami i stanowi uzupełnienie punktów niniejszej witryny:
- Definicja funkcji własnej Excela
- Kwota słownie w Excelu - algorytm krótki, ale trudniejszy.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Kwota słownie w Excelu KLIKNIJ by (roz)winąć

Algorytm przedstawienia kwoty zapisanej liczbą w formie słownej dla Excela jest jednym z częściej poszukiwanych przez osoby odwiedzające niniejszą stronę. Tego typu procedura jest najczęściej używana we wszelkiego typu poleceniach wypłaty, dowodach wpłaty itp. Ze względu na potrzeby mojej pracy zawodowej jest to również jeden z pierwszych plików, które napisałem w VBA. Układ samego algorytmu jest i był prosty: na podstawie wstawionej kwoty w arkuszu pomocniczym Excela, w kilku komórkach, odpowiednimi formułami wyliczana była ilość tysięcy, setek, dziesiątek, jedności i groszy danej liczbą kwoty. Na podstawie uzyskanych wartości przez składanie zmiennych program podstawiał pod zmienną tekstową 'Słownie' wartości napisu. Po wykonaniu do końca algorytmu uzyskana zmienna tekstowa była poszukiwaną kwotą słownie i jako taka była wstawiana do odpowiedniej komórki. Sama procedura nie jest może nadmiernie finezyjna, ale spełnia swoje zadanie i wprowadziłem ją do wszystkich swoich programów gdzie muszę przedstawić dane finansowe. Wadą pliku, w tej postaci zastosowania, jest konieczność utworzenia nowego zapasowego arkusza. Na potrzeby niniejszej strony zamieszczam plik z przykładami dwóch algorytmów, z których każdy uruchamiany jest osobnym przyciskiem. Pierwsze makro określa postać słowną wpisanej kwoty korzystając z danych arkusza. Drugie makro po wprowadzeniu kwoty w oknie InputBox bez posiłkowania się arkuszem określa postać słowną kwoty i wyświetla wynik swojego działania w oknie MsgBox.
- zaletą algorytmów jest prostota zapisu i działania,
- algorytmy pozwalają na zapis słowny kwoty do 99999,99zł,
- zapis jest poprawny gramatycznie i zawiera spacje między poszczególnymi członami.
Korzystanie z makr jest wolne pod warunkiem pozostawienia informacji o autorze w nagłówku procedury. Plik jest do ściągnięcia w postaci archiwum samorozpakowującego na stronie pliki niniejszej witryny.
W programach, które piszę dla potrzeb mojej pracy zawodowej przygotowywałem w oparciu o w/w kod polecenia wypłaty. Jednym z nich jest polecenie wypłaty ekwiwalentu za okna. Na formularzu przyciskami zaznaczam typy okien, a program w oparciu o definiowalne raz w roku dane (koszt okien jest niezmienny w okresie dwunastu miesięcy) oblicza wartość ekwiwalentu. Przycisk 'Wstaw kwotę słownie' przy pomocy w/w makra zdejmuje z użytkownika najbardziej uciążliwą funkcję. Więcej informacji na podstronie programu OKNA KORESPONDENCJA
Jedna z książek opisana na niniejszej stronie tj. Sergiusz Flanczewski 'Excel z elementami VBA w firmie' wyd. Helion 2008 zawiera bardzo ciekawą funkcję użytkownika o nazwie 'SLOX', która realizuje właśnie wstawianie kwoty słownie. Algorytm oparty jest o zmienne tablicowe, dzięki czemu jest, od strony informatycznej, dużo bardziej elegancki niż moja własna propozycja.
Dla osób zainteresowanych tematem uzyskania kwot słownie w excelu i podobnymi polecam artykuły z działu 'Programy do kuchni':
- Kwota słownie w Excelu - algorytm prosty, a długi
- Kwota słownie w Excelu - algorytm krótki, ale trudniejszy
- Obliczenia wartości księgowych w Excelu. Dlaczego suma złotówek się nie zgadza?
- Konwersja typu zmiennej z TextBox - przecinek i kropka w VBA

UWAGA
Przygotowałem samodzielną wtyczkę rozszerzającą możliwości Excela między innymi o zapis słowny kwoty - opis na stronie Dodatek_GK. Zastosowanie wtyczki nie wymaga umiejętności programowania.
Jeżeli masz problemy w wykorzystaniem w/w algorytmu do przygotowania własnego arkusza wypłaty lub podobnego proszę o kontakt /mogę przygotować plik na indywidualne zapotrzebowanie/.

Kwota słownie w excelu - praca w arkuszu Kliknij, żeby (roz)winąć listing

Sub Słownie_Arkusz()

'Autor makra: Grzegorz Koralewski
'www.programywexcelu.boo.pl
'Poznań 2009

Dim Słownie As String
Dim i As Single
Dim Komunikat As Integer

On Error GoTo Błąd:

i = InputBox("Podaj kwotę do przeliczenia", "KWOTA SŁOWNIE w EXCELU", 100)

Arkusz1.Range("C5").Value = i

'Tysiące
If Arkusz1.Range("D8") = "0" Then Słownie = " "
If Arkusz1.Range("D8") = "1" Then Słownie = "jeden tysiąc"
If Arkusz1.Range("D8") = "2" Then Słownie = "dwa tysiące"
If Arkusz1.Range("D8") = "3" Then Słownie = "trzy tysiące"
If Arkusz1.Range("D8") = "4" Then Słownie = "cztery tysiące"
If Arkusz1.Range("D8") = "5" Then Słownie = "pięć tysięcy"
If Arkusz1.Range("D8") = "6" Then Słownie = "sześć tysięcy"
If Arkusz1.Range("D8") = "7" Then Słownie = "siedem tysięcy"
If Arkusz1.Range("D8") = "8" Then Słownie = "osiem tysięcy"
If Arkusz1.Range("D8") = "9" Then Słownie = "dziewięć tysięcy"
If Arkusz1.Range("D8") = "10" Then Słownie = "dziesięć tysięcy"
If Arkusz1.Range("D8") = "11" Then Słownie = "jedenaście tysięcy"
If Arkusz1.Range("D8") = "12" Then Słownie = "dwanaście tysięcy"
If Arkusz1.Range("D8") = "13" Then Słownie = "trzynaście tysięcy"
If Arkusz1.Range("D8") = "14" Then Słownie = "czternaście tysięcy"
If Arkusz1.Range("D8") = "15" Then Słownie = "piętnaście tysięcy"
If Arkusz1.Range("D8") = "16" Then Słownie = "szesnaście tysięcy"
If Arkusz1.Range("D8") = "17" Then Słownie = "siemdemnaście tysięcy"
If Arkusz1.Range("D8") = "18" Then Słownie = "osiemnaście tysięcy"
If Arkusz1.Range("D8") = "19" Then Słownie = "dziewiętnaście tysięcy"
If Arkusz1.Range("D8") = "20" Then Słownie = "dwadzieścia tysięcy"
If Arkusz1.Range("D8") = "21" Then Słownie = "dwadzieścia jeden tysięcy"
If Arkusz1.Range("D8") = "22" Then Słownie = "dwadzieścia dwa tysięce"
If Arkusz1.Range("D8") = "23" Then Słownie = "dwadzieścia trzy tysięce"
If Arkusz1.Range("D8") = "24" Then Słownie = "dwadzieścia cztery tysięce"
If Arkusz1.Range("D8") = "25" Then Słownie = "dwadzieścia pięć tysięcy"
If Arkusz1.Range("D8") = "26" Then Słownie = "dwadzieścia sześć tysięcy"
If Arkusz1.Range("D8") = "27" Then Słownie = "dwadzieścia siedem tysięcy"
If Arkusz1.Range("D8") = "28" Then Słownie = "dwadzieścia osiem tysięcy"
If Arkusz1.Range("D8") = "29" Then Słownie = "dwadzieścia dziewięć tysięcy"
If Arkusz1.Range("D8") = "30" Then Słownie = "trzydzieści tysięcy"
If Arkusz1.Range("D8") = "31" Then Słownie = "trzydzieści jeden tysięcy"
If Arkusz1.Range("D8") = "32" Then Słownie = "trzydzieści dwa tysięcy"
If Arkusz1.Range("D8") = "33" Then Słownie = "trzydzieści trzy tysięce"
If Arkusz1.Range("D8") = "34" Then Słownie = "trzydzieści cztery tysięce"
If Arkusz1.Range("D8") = "35" Then Słownie = "trzydzieści pięć tysięcy"
If Arkusz1.Range("D8") = "36" Then Słownie = "trzydzieści sześć tysięcy"
If Arkusz1.Range("D8") = "37" Then Słownie = "trzydzieści siedem tysięcy"
If Arkusz1.Range("D8") = "38" Then Słownie = "trzydzieści osiem tysięcy"
If Arkusz1.Range("D8") = "39" Then Słownie = "trzydzieści dziewięć tysięcy"
If Arkusz1.Range("D8") = "40" Then Słownie = "czterdzieści tysięcy"
If Arkusz1.Range("D8") = "41" Then Słownie = "czterdzieści jeden tysięcy"
If Arkusz1.Range("D8") = "42" Then Słownie = "czterdzieści dwa tysięce"
If Arkusz1.Range("D8") = "43" Then Słownie = "czterdzieści trzy tysięce"
If Arkusz1.Range("D8") = "44" Then Słownie = "czterdzieści cztery tysięce"
If Arkusz1.Range("D8") = "45" Then Słownie = "czterdzieści pięć tysięcy"
If Arkusz1.Range("D8") = "46" Then Słownie = "czterdzieści sześć tysięcy"
If Arkusz1.Range("D8") = "47" Then Słownie = "czterdzieści siedem tysięcy"
If Arkusz1.Range("D8") = "48" Then Słownie = "czterdzieści osiem tysięcy"
If Arkusz1.Range("D8") = "49" Then Słownie = "czterdzieści dziewięć tysięcy"
If Arkusz1.Range("D8") = "50" Then Słownie = "pięćdziesiąt tysięcy"
If Arkusz1.Range("D8") = "51" Then Słownie = "pięćdziesiąt jeden tysięcy"
If Arkusz1.Range("D8") = "52" Then Słownie = "pięćdziesiąt dwa tysięce"
If Arkusz1.Range("D8") = "53" Then Słownie = "pięćdziesiąt trzy tysięce"
If Arkusz1.Range("D8") = "54" Then Słownie = "pięćdziesiąt cztery tysięce"
If Arkusz1.Range("D8") = "55" Then Słownie = "pięćdziesiąt pięć tysięcy"
If Arkusz1.Range("D8") = "56" Then Słownie = "pięćdziesiąt sześć tysięcy"
If Arkusz1.Range("D8") = "57" Then Słownie = "pięćdziesiąt siedem tysięcy"
If Arkusz1.Range("D8") = "58" Then Słownie = "pięćdziesiąt osiem tysięcy"
If Arkusz1.Range("D8") = "59" Then Słownie = "pięćdziesiąt dziewięć tysięcy"
If Arkusz1.Range("D8") = "60" Then Słownie = "sześćdziesiąt tysięcy"
If Arkusz1.Range("D8") = "61" Then Słownie = "sześćdziesiąt jeden tysięcy"
If Arkusz1.Range("D8") = "62" Then Słownie = "sześćdziesiąt dwa tysięce"
If Arkusz1.Range("D8") = "63" Then Słownie = "sześćdziesiąt trzy tysięce"
If Arkusz1.Range("D8") = "64" Then Słownie = "sześćdziesiąt cztery tysięce"
If Arkusz1.Range("D8") = "65" Then Słownie = "sześćdziesiąt pięć tysięcy"
If Arkusz1.Range("D8") = "66" Then Słownie = "sześćdziesiąt sześć tysięcy"
If Arkusz1.Range("D8") = "67" Then Słownie = "sześćdziesiąt siedem tysięcy"
If Arkusz1.Range("D8") = "68" Then Słownie = "sześćdziesiąt osiem tysięcy"
If Arkusz1.Range("D8") = "69" Then Słownie = "sześćdziesiąt dziewięć tysięcy"
If Arkusz1.Range("D8") = "70" Then Słownie = "siedemdziesiąt tysięcy"
If Arkusz1.Range("D8") = "71" Then Słownie = "siedemdziesiąt jeden tysięcy"
If Arkusz1.Range("D8") = "72" Then Słownie = "siedemdziesiąt dwa tysięce"
If Arkusz1.Range("D8") = "73" Then Słownie = "siedemdziesiąt trzy tysięce"
If Arkusz1.Range("D8") = "74" Then Słownie = "siedemdziesiąt cztery tysięce"
If Arkusz1.Range("D8") = "75" Then Słownie = "siedemdziesiąt pięć tysięcy"
If Arkusz1.Range("D8") = "76" Then Słownie = "siedemdziesiąt sześć tysięcy"
If Arkusz1.Range("D8") = "77" Then Słownie = "siedemdziesiąt siedem tysięcy"
If Arkusz1.Range("D8") = "78" Then Słownie = "siedemdziesiąt osiem tysięcy"
If Arkusz1.Range("D8") = "79" Then Słownie = "siedemdziesiąt dziewięć tysięcy"
If Arkusz1.Range("D8") = "80" Then Słownie = "osiemdziesiąt tysięcy"
If Arkusz1.Range("D8") = "81" Then Słownie = "osiemdziesiąt jeden tysięcy"
If Arkusz1.Range("D8") = "82" Then Słownie = "osiemdziesiąt dwa tysięce"
If Arkusz1.Range("D8") = "83" Then Słownie = "osiemdziesiąt trzy tysięce"
If Arkusz1.Range("D8") = "84" Then Słownie = "osiemdziesiąt cztery tysięce"
If Arkusz1.Range("D8") = "85" Then Słownie = "osiemdziesiąt pięć tysięcy"
If Arkusz1.Range("D8") = "86" Then Słownie = "osiemdziesiąt sześć tysięcy"
If Arkusz1.Range("D8") = "87" Then Słownie = "osiemdziesiąt siedem tysięcy"
If Arkusz1.Range("D8") = "88" Then Słownie = "osiemdziesiąt osiem tysięcy"
If Arkusz1.Range("D8") = "89" Then Słownie = "osiemdziesiąt dziewięć tysięcy"
If Arkusz1.Range("D8") = "90" Then Słownie = "dziewięćdziesiąt tysięcy"
If Arkusz1.Range("D8") = "91" Then Słownie = "dziewięćdziesiąt jeden tysięcy"
If Arkusz1.Range("D8") = "92" Then Słownie = "dziewięćdziesiąt dwa tysięce"
If Arkusz1.Range("D8") = "93" Then Słownie = "dziewięćdziesiąt trzy tysięce"
If Arkusz1.Range("D8") = "94" Then Słownie = "dziewięćdziesiąt cztery tysięce"
If Arkusz1.Range("D8") = "95" Then Słownie = "dziewięćdziesiąt pięć tysięcy"
If Arkusz1.Range("D8") = "96" Then Słownie = "dziewięćdziesiąt sześć tysięcy"
If Arkusz1.Range("D8") = "97" Then Słownie = "dziewięćdziesiąt siedem tysięcy"
If Arkusz1.Range("D8") = "98" Then Słownie = "dziewięćdziesiąt osiem tysięcy"
If Arkusz1.Range("D8") = "99" Then Słownie = "dziewięćdziesiąt dziewięć tysięcy"

'Setki
If Arkusz1.Range("E9") = "0" Then Słownie = Słownie & " "
If Arkusz1.Range("E9") = "1" Then Słownie = Słownie & " sto"
If Arkusz1.Range("E9") = "2" Then Słownie = Słownie & " dwieście"
If Arkusz1.Range("E9") = "3" Then Słownie = Słownie & " trzysta"
If Arkusz1.Range("E9") = "4" Then Słownie = Słownie & " czterysta"
If Arkusz1.Range("E9") = "5" Then Słownie = Słownie & " pięćset"
If Arkusz1.Range("E9") = "6" Then Słownie = Słownie & " sześćset"
If Arkusz1.Range("E9") = "7" Then Słownie = Słownie & " siedemset"
If Arkusz1.Range("E9") = "8" Then Słownie = Słownie& " osiemset"
If Arkusz1.Range("E9") = "9" Then Słownie = Słownie & " dziewięćset"

'Dziesiątki
If Arkusz1.Range("F10") = "0" Then Słownie = Słownie & " "
If Arkusz1.Range("F10") = "1" And Arkusz1.Range("G11") = "0" Then Słownie = Słownie & " dziesięć złotych "
If Arkusz1.Range("F10") = "1" And Arkusz1.Range("G11") = "1" Then Słownie = Słownie & " jedenaście złotych "
If Arkusz1.Range("F10") = "1" And Arkusz1.Range("G11") = "2" Then Słownie = Słownie & " dwanaście złotych "
If Arkusz1.Range("F10") = "1" And Arkusz1.Range("G11") = "3" Then Słownie = Słownie & " trzynaście złotych "
If Arkusz1.Range("F10") = "1" And Arkusz1.Range("G11") = "4" Then Słownie = Słownie & " czternaście złotych "
If Arkusz1.Range("F10") = "1" And Arkusz1.Range("G11") = "5" Then Słownie = Słownie & " piętnaście złotych "
If Arkusz1.Range("F10") = "1" And Arkusz1.Range("G11") = "6" Then Słownie = Słownie & " szesnaście złotych "
If Arkusz1.Range("F10") = "1" And Arkusz1.Range("G11") = "7" Then Słownie = Słownie & " siedemnaście złotych "
If Arkusz1.Range("F10") = "1" And Arkusz1.Range("G11") = "8" Then Słownie = Słownie & " osiemnaście złotych "
If Arkusz1.Range("F10") = "1" And Arkusz1.Range("G11") = "9" Then Słownie = Słownie & " dziewiętnaście złotych "
If Arkusz1.Range("F10") = "2" Then Słownie = Słownie & " dwadzieścia"
If Arkusz1.Range("F10") = "3" Then Słownie = Słownie & " trzydzieści"
If Arkusz1.Range("F10") = "4" Then Słownie = Słownie & " czterdzieści"
If Arkusz1.Range("F10") = "5" Then Słownie = Słownie & " pięćdziesiąt"
If Arkusz1.Range("F10") = "6" Then Słownie = Słownie & " sześćdziesiąt"
If Arkusz1.Range("F10") = "7" Then Słownie = Słownie & " siedemdziesiąt"
If Arkusz1.Range("F10") = "8" Then Słownie = Słownie & " osiemdziesiąt"
If Arkusz1.Range("F10") = "9" Then Słownie = Słownie & " dziewięćdziesiąt"

'Jedności
If Arkusz1.Range("G11") = "0" And Arkusz1.Range("F10") <> "1" Then Słownie = Słownie & " złotych "
If Arkusz1.Range("G11") = "1" And Arkusz1.Range("F10") <> "1" Then Słownie = Słownie & " jeden złotych "
If Arkusz1.Range("G11") = "2" And Arkusz1.Range("F10") <> "1" Then Słownie = Słownie & " dwa złote "
If Arkusz1.Range("G11") = "3" And Arkusz1.Range("F10") <> "1" Then Słownie = Słownie & " trzy złote "
If Arkusz1.Range("G11") = "4" And Arkusz1.Range("F10") <> "1" Then Słownie = Słownie & " cztery złote "
If Arkusz1.Range("G11") = "5" And Arkusz1.Range("F10") <> "1" Then Słownie = Słownie & " pięć złotych "
If Arkusz1.Range("G11") = "6" And Arkusz1.Range("F10") <> "1" Then Słownie = Słownie & " sześć złotych "
If Arkusz1.Range("G11") = "7" And Arkusz1.Range("F10") <> "1" Then Słownie = Słownie & " siedem złotych "
If Arkusz1.Range("G11") = "8" And Arkusz1.Range("F10") <> "1" Then Słownie = Słownie & " osiem złotych "
If Arkusz1.Range("G11") = "9" And Arkusz1.Range("F10") <> "1" Then Słownie = Słownie & " dziewięć złotych "

'Warunek gdy zero złotych lub jeden złoty
If Arkusz1.Range("C5") < 1 And Arkusz1.Range("C5") >= 0 Then Słownie = "zero złotych "
If Arkusz1.Range("C5") >= 1 And Arkusz1.Range("C5") < 2 Then Słownie = "jeden złoty "

'Grosze
If Arkusz1.Range("H13") = "" Then Słownie = Słownie & "0/100 groszy"
If Arkusz1.Range("H13") <> "" Then Słownie = Słownie & CCur(Format(Arkusz1.Range("H13"), "0.#0")) & "/100 groszy"

Słownie = "(Słownie:" & Słownie & ")"

Arkusz1.Range("C20").Value = Słownie

Exit Sub

Błąd:
Komunikat = MsgBox("Wprowadzono złą wartość", vbInformation + vbOKOnly, "KWOTA SŁOWNIE w EXCELU")

End Sub


Kwota słownie w excelu - praca w VBA Kliknij, żeby (roz)winąć listing

Sub Słownie_procedura()

'Autor makra: Grzegorz Koralewski
'www.programywexcelu.boo.pl
'Poznań 2009

Dim Słownie As String
Dim Kwota_liczba As Single
Dim Tysiące As Single
Dim Setki As Single
Dim Dziesiątki As Single
Dim Jedności As Single
Dim Grosze As Single
Dim Komunikat As Integer

On Error GoTo Błąd:

Kwota_liczba = InputBox("Podaj kwotę do przeliczenia", "KWOTA SŁOWNIE w EXCELU", 100)

'Kwota_słownie.Value = Kwota_liczba

Tysiące = Fix(Kwota_liczba / 1000)
Setki = Fix(Kwota_liczba / 100 - Tysiące * 10)
Dziesiątki = Fix(Kwota_liczba / 10 - Tysiące * 100 - Setki * 10)
Jednostki = Fix(Kwota_liczba) - (Fix(Kwota_liczba / 10) * 10)
Grosze = Fix(((Kwota_liczba) - (Fix(Kwota_liczba / 10) * 10) - (Fix(Kwota_liczba) - (Fix(Kwota_liczba / 10) * 10))) * 100)

'**************************************************************************************************************************
'**************************************************************************************************************************

'Tysiące
If Tysiące = 0 Then Słownie = " "
If Tysiące = 1 Then Słownie = "jeden tysiąc"
If Tysiące = 2 Then Słownie = "dwa tysiące"
If Tysiące = 3 Then Słownie = "trzy tysiące"
If Tysiące = 4 Then Słownie = "cztery tysiące"
If Tysiące = 5 Then Słownie = "pięć tysięcy"
If Tysiące = 6 Then Słownie = "sześć tysięcy"
If Tysiące = 7 Then Słownie = "siedem tysięcy"
If Tysiące = 8 Then Słownie = "osiem tysięcy"
If Tysiące = 9 Then Słownie = "dziewięć tysięcy"
If Tysiące = 10 Then Słownie = "dziesięć tysięcy"
If Tysiące = 11 Then Słownie = "jedenaście tysięcy"
If Tysiące = 12 Then Słownie = "dwanaście tysięcy"
If Tysiące = 13 Then Słownie = "trzynaście tysięcy"
If Tysiące = 14 Then Słownie = "czternaście tysięcy"
If Tysiące = 15 Then Słownie = "piętnaście tysięcy"
If Tysiące = 16 Then Słownie = "szesnaście tysięcy"
If Tysiące = 17 Then Słownie = "siemdemnaście tysięcy"
If Tysiące = 18 Then Słownie = "osiemnaście tysięcy"
If Tysiące = 19 Then Słownie = "dziewiętnaście tysięcy"
If Tysiące = 20 Then Słownie = "dwadzieścia tysięcy"
If Tysiące = 21 Then Słownie = "dwadzieścia jeden tysięcy"
If Tysiące = 22 Then Słownie = "dwadzieścia dwa tysięce"
If Tysiące = 23 Then Słownie = "dwadzieścia trzy tysięce"
If Tysiące = 24 Then Słownie = "dwadzieścia cztery tysięce"
If Tysiące = 25 Then Słownie = "dwadzieścia pięć tysięcy"
If Tysiące = 26 Then Słownie = "dwadzieścia sześć tysięcy"
If Tysiące = 27 Then Słownie = "dwadzieścia siedem tysięcy"
If Tysiące = 28 Then Słownie = "dwadzieścia osiem tysięcy"
If Tysiące = 29 Then Słownie = "dwadzieścia dziewięć tysięcy"
If Tysiące = 30 Then Słownie = "trzydzieści tysięcy"
If Tysiące = 31 Then Słownie = "trzydzieści jeden tysięcy"
If Tysiące = 32 Then Słownie = "trzydzieści dwa tysięcy"
If Tysiące = 33 Then Słownie = "trzydzieści trzy tysięce"
If Tysiące = 34 Then Słownie = "trzydzieści cztery tysięce"
If Tysiące = 35 Then Słownie = "trzydzieści pięć tysięcy"
If Tysiące = 36 Then Słownie = "trzydzieści sześć tysięcy"
If Tysiące = 37 Then Słownie = "trzydzieści siedem tysięcy"
If Tysiące = 38 Then Słownie = "trzydzieści osiem tysięcy"
If Tysiące = 39 Then Słownie = "trzydzieści dziewięć tysięcy"
If Tysiące = 40 Then Słownie = "czterdzieści tysięcy"
If Tysiące = 41 Then Słownie = "czterdzieści jeden tysięcy"
If Tysiące = 42 Then Słownie = "czterdzieści dwa tysięce"
If Tysiące = 43 Then Słownie = "czterdzieści trzy tysięce"
If Tysiące = 44 Then Słownie = "czterdzieści cztery tysięce"
If Tysiące = 45 Then Słownie = "czterdzieści pięć tysięcy"
If Tysiące = 46 Then Słownie = "czterdzieści sześć tysięcy"
If Tysiące = 47 Then Słownie = "czterdzieści siedem tysięcy"
If Tysiące = 48 Then Słownie = "czterdzieści osiem tysięcy"
If Tysiące = 49 Then Słownie = "czterdzieści dziewięć tysięcy"
If Tysiące = 50 Then Słownie = "pięćdziesiąt tysięcy"
If Tysiące = 51 Then Słownie = "pięćdziesiąt jeden tysięcy"
If Tysiące = 52 Then Słownie = "pięćdziesiąt dwa tysięce"
If Tysiące = 53 Then Słownie = "pięćdziesiąt trzy tysięce"
If Tysiące = 54 Then Słownie = "pięćdziesiąt cztery tysięce"
If Tysiące = 55 Then Słownie = "pięćdziesiąt pięć tysięcy"
If Tysiące = 56 Then Słownie = "pięćdziesiąt sześć tysięcy"
If Tysiące = 57 Then Słownie = "pięćdziesiąt siedem tysięcy"
If Tysiące = 58 Then Słownie = "pięćdziesiąt osiem tysięcy"
If Tysiące = 59 Then Słownie = "pięćdziesiąt dziewięć tysięcy"
If Tysiące = 60 Then Słownie = "sześćdziesiąt tysięcy"
If Tysiące = 61 Then Słownie = "sześćdziesiąt jeden tysięcy"
If Tysiące = 62 Then Słownie = "sześćdziesiąt dwa tysięce"
If Tysiące = 63 Then Słownie = "sześćdziesiąt trzy tysięce"
If Tysiące = 64 Then Słownie = "sześćdziesiąt cztery tysięce"
If Tysiące = 65 Then Słownie = "sześćdziesiąt pięć tysięcy"
If Tysiące = 66 Then Słownie = "sześćdziesiąt sześć tysięcy"
If Tysiące = 67 Then Słownie = "sześćdziesiąt siedem tysięcy"
If Tysiące = 68 Then Słownie = "sześćdziesiąt osiem tysięcy"
If Tysiące = 69 Then Słownie = "sześćdziesiąt dziewięć tysięcy"
If Tysiące = 70 Then Słownie = "siedemdziesiąt tysięcy"
If Tysiące = 71 Then Słownie = "siedemdziesiąt jeden tysięcy"
If Tysiące = 72 Then Słownie = "siedemdziesiąt dwa tysięce"
If Tysiące = 73 Then Słownie = "siedemdziesiąt trzy tysięce"
If Tysiące = 74 Then Słownie = "siedemdziesiąt cztery tysięce"
If Tysiące = 75 Then Słownie = "siedemdziesiąt pięć tysięcy"
If Tysiące = 76 Then Słownie = "siedemdziesiąt sześć tysięcy"
If Tysiące = 77 Then Słownie = "siedemdziesiąt siedem tysięcy"
If Tysiące = 78 Then Słownie = "siedemdziesiąt osiem tysięcy"
If Tysiące = 79 Then Słownie = "siedemdziesiąt dziewięć tysięcy"
If Tysiące = 80 Then Słownie = "osiemdziesiąt tysięcy"
If Tysiące = 81 Then Słownie = "osiemdziesiąt jeden tysięcy"
If Tysiące = 82 Then Słownie = "osiemdziesiąt dwa tysięce"
If Tysiące = 83 Then Słownie = "osiemdziesiąt trzy tysięce"
If Tysiące = 84 Then Słownie = "osiemdziesiąt cztery tysięce"
If Tysiące = 85 Then Słownie = "osiemdziesiąt pięć tysięcy"
If Tysiące = 86 Then Słownie = "osiemdziesiąt sześć tysięcy"
If Tysiące = 87 Then Słownie = "osiemdziesiąt siedem tysięcy"
If Tysiące = 88 Then Słownie = "osiemdziesiąt osiem tysięcy"
If Tysiące = 89 Then Słownie = "osiemdziesiąt dziewięć tysięcy"
If Tysiące = 90 Then Słownie = "dziewięćdziesiąt tysięcy"
If Tysiące = 91 Then Słownie = "dziewięćdziesiąt jeden tysięcy"
If Tysiące = 92 Then Słownie = "dziewięćdziesiąt dwa tysięce"
If Tysiące = 93 Then Słownie = "dziewięćdziesiąt trzy tysięce"
If Tysiące = 94 Then Słownie = "dziewięćdziesiąt cztery tysięce"
If Tysiące = 95 Then Słownie = "dziewięćdziesiąt pięć tysięcy"
If Tysiące = 96 Then Słownie = "dziewięćdziesiąt sześć tysięcy"
If Tysiące = 97 Then Słownie = "dziewięćdziesiąt siedem tysięcy"
If Tysiące = 98 Then Słownie = "dziewięćdziesiąt osiem tysięcy"
If Tysiące = 99 Then Słownie = "dziewięćdziesiąt dziewięć tysięcy"

'Setki
If Setki = 0 Then Słownie = Słownie & " "
If Setki = 1 Then Słownie = Słownie & " sto"
If Setki = 2 Then Słownie = Słownie & " dwieście"
If Setki = 3 Then Słownie = Słownie & " trzysta"
If Setki = 4 Then Słownie = Słownie & " czterysta"
If Setki = 5 Then Słownie = Słownie & " pięćset"
If Setki = 6 Then Słownie = Słownie & " sześćset"
If Setki = 7 Then Słownie = Słownie & " siedemset"
If Setki = 8 Then Słownie = Słownie & " osiemset"
If Setki = 9 Then Słownie = Słownie & " dziewięćset"

'Dziesiątki
If Dziesiątki = 0 Then Słownie = Słownie & " "
If Dziesiątki = 1 And Jedności = 0 Then Słownie = Słownie & " dziesięć złotych "
If Dziesiątki = 1 And Jedności = 1 Then Słownie = Słownie & " jedenaście złotych "
If Dziesiątki = 1 And Jedności = 2 Then Słownie = Słownie & " dwanaście złotych "
If Dziesiątki = 1 And Jedności = 3 Then Słownie = Słownie & " trzynaście złotych "
If Dziesiątki = 1 And Jedności = 4 Then Słownie = Słownie & " czternaście złotych "
If Dziesiątki = 1 And Jedności = 5 Then Słownie = Słownie & " piętnaście złotych "
If Dziesiątki = 1 And Jedności = 6 Then Słownie = Słownie & " szesnaście złotych "
If Dziesiątki = 1 And Jedności = 7 Then Słownie = Słownie & " siedemnaście złotych "
If Dziesiątki = 1 And Jedności = 8 Then Słownie = Słownie & " osiemnaście złotych "
If Dziesiątki = 1 And Jedności = 9 Then Słownie = Słownie & " dziewiętnaście złotych "
If Dziesiątki = 2 Then Słownie = Słownie & " dwadzieścia"
If Dziesiątki = 3 Then Słownie = Słownie & " trzydzieści"
If Dziesiątki = 4 Then Słownie = Słownie & " czterdzieści"
If Dziesiątki = 5 Then Słownie = Słownie & " pięćdziesiąt"
If Dziesiątki = 6 Then Słownie = Słownie & " sześćdziesiąt"
If Dziesiątki = 7 Then Słownie = Słownie & " siedemdziesiąt"
If Dziesiątki = 8 Then Słownie = Słownie & " osiemdziesiąt"
If Dziesiątki = 9 Then Słownie = Słownie & " dziewięćdziesiąt"

'Jedności
If Jednostki = 0 And Dziesiątki <> 1 Then Słownie = Słownie & " złotych "
If Jednostki = 1 And Dziesiątki <> 1 Then Słownie = Słownie & " jeden złotych "
If Jednostki = 2 And Dziesiątki <> 1 Then Słownie = Słownie & " dwa złote "
If Jednostki = 3 And Dziesiątki <> 1 Then Słownie = Słownie & " trzy złote "
If Jednostki = 4 And Dziesiątki <> 1 Then Słownie = Słownie & " cztery złote "
If Jednostki = 5 And Dziesiątki <> 1 Then Słownie = Słownie & " pięć złotych "
If Jednostki = 6 And Dziesiątki <> 1 Then Słownie = Słownie & " sześć złotych "
If Jednostki = 7 And Dziesiątki <> 1 Then Słownie = Słownie & " siedem złotych "
If Jednostki = 8 And Dziesiątki <> 1 Then Słownie = Słownie & " osiem złotych "
If Jednostki = 9 And Dziesiątki <> 1 Then Słownie = Słownie & " dziewięć złotych "

'Warunek gdy zero złotych lub jeden złoty
If Kwota_liczba < 1 And Kwota_liczba >= 0 Then Słownie = "zero złotych "
If Kwota_liczba >= 1 And Kwota_liczba < 2 Then Słownie = "jeden złoty "

'Grosze
If Grosze = 0 Then Słownie = Słownie & "0/100 groszy"
If Grosze <> 0 Then Słownie = Słownie & CCur(Format(Grosze, "0.#0")) & "/100 groszy"

'**************************************************************************************************************************
'**************************************************************************************************************************

Komunikat = MsgBox("Ilość tysięcy: " & Tysiące & Chr(10) & "Ilość setek: " & Setki & Chr(10) & "Ilość dziesiątek: " & _
Dziesiątki & Chr(10) & "Ilość jednostek: " & Jednostki & Chr(10) & _
"Ilość groszy: " & Grosze & Chr(10) & _
"Kwota słownie: " & Słownie, vbInformation + vbOKOnly, "KWOTA SŁOWNIE w EXCELU")

Exit Sub

Błąd:
Komunikat = MsgBox("Wprowadzono złą wartość", vbInformation + vbOKOnly, "KWOTA SŁOWNIE w EXCELU")

End Sub

UWAGA:
Przygotowałem samodzielną wtyczkę rozszerzającą możliwości Excela między innymi o zapis słowny kwoty - opis na stronie Dodatek_GK. Zastosowanie wtyczki nie wymaga umiejętności programowania.
W punkcie przedstawiono proste algorytmy realizujące często poszukiwaną funkcję - zapis kwoty w postaci słownej dla Excela. Jest to jedno z wielu możliwych rozwiązań tego typu zadania. Dla osób nie zainteresowanych samodzielnym wprowadzaniem tego typu funcji przygotowałem samodzielny dodatek do Excela eliminujący potrzebę nauki programowania. Dodatek wprowadza nową funkcję "=Kwota_słownie()" dostępną z zakresu funkcji finansowych. Opierając się na innym niż przedstawiony w tym punkcie algortymie obsługuje liczby do wartości 999.999.999.999,99 i pozwala opcjonalnie wprowadzać symbol waluty.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Lista obecności pracowników KLIKNIJ by (roz)winąć

Ze względu na fakt, że lista obecności pracowników jest jednym z popularniejszych tematów (w ciągu kilku pierwszych tygodni funkcjonowania strony kilkadziesiąt wejść różnych użytkowników związanych było z tym zapytaniem) przygotowałem osobny plik drukujący listę obecności. Programik został opracowany w oparciu o taki sam, funkcjonujący w mojej pracy, a przedstawiony na stronie Lista obecności na Os. Rusa. Zasada działania, instrukcja obsługi itp. są identyczne. Jedyne różnice to:
- rezygnacja z logo SM OM w Poznaniu (plik jest teraz bezosobowy),
- rozszerzenie ilości pracowników w ostatniej grupie do dwudziestu osób.
Plik pozwala teraz na:
- wydruk listy obecności dla trzech niezależnych grup pracowników po dwadzieścia osób każda grupa,
- lista obecności uwzględni dni świąteczne ustawowo wolne od pracy (stałe i ruchome),
- lista obecności pozwala na określenie dodatkowych dni wolnych i pracujących dla danego zakładu pracy,
Plik w postaci archiwum samorozpakowującego dostępny jest do ściągnięcia na stronie pliki niniejszej witryny.
Jest wolny w stosowaniu - warunkiem jest pozostawienie informacji o autorze w stopce wydruku.

UWAGA
Jeżeli możliwości proponowanej listy obecności nie do końca odpowiadają Twoim oczekiwaniom proszę o kontakt /mogę przygotować plik na indywidualne zapotrzebowanie/.

Prosty, ale przydatny w praktyce wielu firm aplikacja do wydruku miesięcznej listy obecności pracowników w kilku grupach zatrudnienia. Rozpoznaje i oznacza dni tygodnia, dni świąt stałych i ruchomych. Przykład powstał na podstawie używanego w praktyce mojego pracodawcy pliku z listą obecności. Przykład do ściągnięcia w dziale pliki.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Rejestr zakupów KLIKNIJ by (roz)winąć

Ze względu na fakt, że rejestr zakupów jest drugim po liście obecności pracowników najpopularniejszym tematem (w ciągu kilku pierwszych tygodni funkcjonowania strony kilkadziesiąt wejść różnych użytkowników związanych było z tym zapytaniem) przygotowałem osobny plik drukujący rejestr zakupów. Programik został opracowany w oparciu o taki sam, funkcjonujący w mojej pracy, a omawiany w bieżącym punkcie i przedstawiony na stronie Rejestr zakupów na Os. Rusa. Zasada działania, instrukcja obsługi itp. są identyczne. Jedyne różnice to:
- rezygnacja z logo SM OM w Poznaniu (plik jest teraz bezosobowy),
- rezygnacja z listy zdefiniowanych firm.
Plik zgodnie z żądaniem użytkownika jest bardzo prosty - automatyzuje jedynie wprowadzanie danych, wydruk, sprawdzenia sumy kwot cząstkowych itp. tym niemniej może komuś się przyda.

UWAGA
Jeżeli możliwości proponowanego pliku nie do końca odpowiadają Twoim oczekiwaniom proszę o kontakt /mogę przygotować plik na indywidualne zapotrzebowanie/.

Proste, ale stosowany w praktyce wielu firm zadanie przygotowania odpowiednio sformatowanego rejestru zakupów z oznaczeniem poszczególnych grup podatków. Plik automatyzuje wprowadzanie danych i ich wydruk, przeprowadzająć w tle sprawdzenie ich poprawności wg zdefiniowanego algorytmu. Przykład do ściągnięcia w dziale pliki.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Pętla For-Each - działanie na elementach zbioru w VBA KLIKNIJ by (roz)winąć

Temat ten powstał jako odpowiedź na zapytanie 'Jak sprawdzić ilość arkuszy w skoroszycie excela'. Realizacja zadań odnoszących się do nieznanej liczby elementów w danej kolekcji wiąże się z wprowadzeniem pętli For Each _ Next. Pętla ta służy do wykonywania operacji na wszystkich elementach danego zbioru lub na tych elementach, które spełniają zadane kryteria.
Składnia pętli jest następująca:

For Each element In grupa
[instrukcje]
[Exit For]
[instrukcje]
Next [element]

Pętla bywa wykorzystywana przy odwoływaniu się do elementów tablicy lub zbioru.

W przykładzie zastosowano następujące zadania:
- Liczenie liczby arkuszy aktywnego skoroszytu z podaniem nazw kolejnych elementów,
- Ukrywanie arkuszy aktywnego skoroszytu z pominięciem skoroszytu aktywnego,
- Pokazywanie wszystkich arkuszy aktywnego skoroszytu
- Liczenie bezbarwnych i kolorowych komórek w zadanym zakresie

Pierwsze trzy zadania przetwarzają zbiór Sheets aktywnego skoroszytu, a ostatnie przetwarza zbiór Cell w grupie 'Zaznaczony_obszar', która jest zmienną wprowadzaną metodą InputBox Excela. Makra przypisane są do opisanych przycisków, a ich kod zawarty jest w Module1 i Module2 załączonego pliku. Plik do ściągnięcia w dziale pliki. Plik będący załącznikiem przykładu jest wspólny dla kilku punktów tej podstrony i poza elementami wyżej wymienionymi obejmuje proste makro do scalania, wyśrodkowywania w pionie i poziomie oraz zawijania tekstu zaznaczonych komórek. Więcej informacji na temat wyżej wymienionej pętli zawarte jest w książce Programowanie VBA w Excelu 2003 Walkenbacha (str. 212). Pętle tego typu nie są natomiast omówione w książce Makropolecenia w Excelu pani Snarskiej.

Makra z wykorzystaniem petli For Each Next Kliknij, żeby (roz)winąć listing

Sub Liczenie_arkuszy()
Dim Arkusz_roboczy As Worksheet
Dim Liczba_arkuszy As Integer

Liczba_arkuszy = 0

For Each Arkusz_roboczy In ActiveWorkbook.Worksheets

Liczba_arkuszy = Liczba_arkuszy + 1
MsgBox Arkusz_roboczy.Name

Next Arkusz_roboczy

MsgBox "Liczba arkuszy: " & Liczba_arkuszy & " szt"
End Sub

Sub Ukrywanie_arkuszy()
Dim Arkusz_roboczy As Worksheet

For Each Arkusz_roboczy In ActiveWorkbook.Worksheets
If Arkusz_roboczy.Name <> ActiveSheet.Name Then Arkusz_roboczy.Visible = xlSheetHidden
Next Arkusz_roboczy
End Sub

Sub Pokazywanie_arkuszy()
Dim Arkusz_roboczy As Worksheet

For Each Arkusz_roboczy In ActiveWorkbook.Worksheets
Arkusz_roboczy.Visible = xlSheetVisible
Next Arkusz_roboczy
End Sub

W punkcie przedstawiono pętlę stosowaną przy przetwarzaniu nieznanej listy elementów danej kolekcji. Stosowana w przypadku działań na arkuszach, działań na obszarach plików itp. Pętle o nieznanej liczbie powtórzeń muszą mieć zadany warunek wejściowy/wyjściowy, pętle o znanej ilości powtórzeń nie nadają się do tego typu zadań. Znajomość pętli For Each ... In ... Next jest niezbędna dla nieco bardziej zaawansowanej pracy przy pisaniu makropoleceń. Przykład powstał na podstawie zapytań jednego z użytkowników strony o sposób podliczenia ilości arkuszy w danym skoroszycie.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Metoda InputBox Excela KLIKNIJ by (roz)winąć

Polecenie InputBox w VBA było omówione w podpunkcie dotyczącym zastosowania przycisku 'Cancel' tego polecenia VBA. Obecnie przy okazji omawiania zapytania dotyczącego sprawdzenia ilości kolorowych komórek w zadanym zakresie chciałbym omówić zastosowanie metody InputBox Excela. Materiał przygotowany został na podstawie książki pana Walkenbacha.
Pierwsze pytanie - dlaczego stosować metodę Excela skoro dostępne jest polecenie VBA?
Metoda InputBox nie zastępuje całkowicie polecenia InputBox, ale jej wykorzystanie ma następujące korzyści:
- można określić typ zwracanej wartości
   kod identyfikujący: 0 Znaczenie: Formuła,
   kod identyfikujący: 1 Znaczenie: Liczba,
   kod identyfikujący: 2 Znaczenie: Łańcuch tekstowy,
   kod identyfikujący: 4 Znaczenie: Wartość logiczna,
   kod identyfikujący: 8 Znaczenie: obiekt Range (zakres komórek),
   kod identyfikujący: 16 Znaczenie: wartość błędu,
   kod identyfikujący: 64 Znaczenie: tablica wartości,
  Jeżeli metoda ma zwracać więcej niż jeden typ zmiennych należy użyć sumy odpowiednich kodów,
- użytkownik programu może określić zakres przez zaznaczenie go w aktywnym arkuszu (baaardzo wygodne),
- jeżeli możemy określić typ danych tzn. że sprawdzenie poprawności wprowadzenia następuje automatycznie,

Składnia metody InputBox Excela jest następująca:
obiekt.InputBox(komunikat, tytuł, wartość domyślna, współrzędna x, współrzędna y, plik pomocy, kontekst, typ)
- komunikat (wymagany) - tekst wyświetlony w oknie wprowadzania danych,
- tytuł (opcjonalny) - tytuł okna wprowadzania danych,
- wartość domyślna (wartość opcjonalna) - domyślna wartość zwracana przez funkcję, gdy użytkownik jeszcze nie wprowadził danych,
- współrzędne x, y (opcjonalne) - współrzędne pozycji górnego, lewego narożnika okna,
- plik pomocy, kontekst (opcjonalnie) - plik i temat pomocy,
- typ (opcjonalny) - kod identyfikujący typ danych zwracanej wartości,

W przykładzie makro liczy w zaznaczonym zakresie ilość komórek całkowitą i ilość komórek kolorowych. Wynik wyświetlany jest w oknie MsgBox.
Plik będący załącznikiem przykładu jest wspólny dla kilku punktów tej podstrony i poza elementami wyżej wymienionymi obejmuje proste makro do scalania, wyśrodkowywania w pionie i poziomie oraz zawijania tekstu zaznaczonych komórek, liczenie ilości arkuszy aktywnego skoroszytu z podaniem nazw kolejnych elementów, ukrywanie arkuszy aktywnego skoroszytu z pominięciem skoroszytu aktywnego, pokazywanie wszystkich arkuszy aktywnego skoroszytu. Makra przypisane są do opisanych przycisków, a ich kod zawarty jest w Module1 i Module2 załączonego pliku. Plik do ściągnięcia w dziale pliki.
Więcej informacji na temat metody InputBox zawarte jest w książce Programowanie VBA w Excelu 2003 Walkenbacha (str. 349-350). Metoda nie jest natomiast omówiona w książce Makropolecenia w Excelu pani Snarskiej.

Liczenie ilości kolorowych komorek w zakresie - metoda InputBox Excela Kliknij, żeby (roz)winąć listing

Sub Liczenie_kolorowych_komorek()
Dim Zaznaczony_obszar As Range
Dim Licznik_koloru As Integer
Dim Licznik_wszystkich As Integer

Licznik_koloru = 0
Adres_obszaru = Selection.Address

On Error GoTo Przerwa

Set Zaznaczony_obszar = Application.InputBox _
   (Prompt:="Podaj zakres do zliczenia kolorowych komórek", _
   Title:="Liczenie kolorowych kleksów", _
   Default:=Adres_obszaru, _
   Type:=8)
For Each Cell In Zaznaczony_obszar
   Licznik_wszystkich = Licznik_wszystkich + 1
   If Cell.Interior.ColorIndex <> xlNone Then Licznik_koloru = Licznik_koloru + 1
Next Cell
 v MsgBox "Liczba komórek kolorowych: " & Licznik_koloru & _
   " szt." & Chr(10) & _
   "Liczba wszystkich komórek: " & Licznik_wszystkich & " szt."
Exit Sub

Przerwa:
End Sub

Metoda InputBox Excela jest podobna do polecenia VBA o tej samej nazwie, ale pozwala np. skontrolować typ wprowadzanej wartości i - co bardzo ważne - umożliwia wprowadzanie użytkownikowi danego zakresu komórek przez jego zaznaczenie w arkuszu. Znajomość tej metody jest niezbędna przy pisaniu aplikacji, gdzie konieczny jest ten sposób interakcji z użytkownikiem.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Zdarzenie Change arkusza Excela KLIKNIJ by (roz)winąć

Zdarzenia związane z arkuszem należą do najbardziej przydatnych przy pracy z Excelem. Niektóre zastosowania to np. wywoływanie makra przy modyfikacji wybranego zakresu arkusza (również pojedynczej komórki), zaawansowane sprawdzanie poprawności danych wprowadzanych w zakresie arkusza lub monitorowanie zakresu komórek w celu pogrubienia odpowiednich wartości itp.,
Załącznikiem tego punktu jest plik 'Zdarzenie_Change' (do ściągnięcia w dziale pliki). Plik Excela składa się z trzech arkuszy dla których określiłem różne przypadki zdarzenia Change:
- Arkusz 1 modyfikacja dowolnej komórki arkusza powoduje wyświetlenie okna komunikatu z podaniem adresu zmodyfikowanej komórki,
- Arkusz 2 modyfikacja komórki z zakresu B7:I20 powoduje wyświetlenie okna komunikatu z podaniem adresu zmodyfikowanej komórki, natomiast modyfikacja komórki A1 lub A2 powoduje wywołanie makra wyświetlającego komunikat,
- Arkusz 3 modyfikacja komórki z zakresu B7:I20 powoduje sprawdzenie czy wprowadzono liczbę całkowitą z zakresu od 1 do 20. Jeżeli tak to nic się nie dzieje, jeżeli nie to program wyświetli odpowiedni komunikat z podaniem rodzaju błędu.
Zdarzenie Change następuje przy modyfikacji dowolnej komórki arkusza przez użytkownika lub procedurę VBA. Zdarzenia Change nie wywołuje natomiast zmiana wartości formuły w komórce, dodanie/usunięcie komentarza, sortowanie komórek itp. Ciekawostką jest fakt, że użycie przycisku 'Delete' wywołuje zdarzenie Change nawet jeżeli komórka była pusta.
Zdarzenie Worksheet_Change pobiera obiekt typu Range (zakres) jako argument Target. W swojej najprostszej postaci monitorowana jest zawartość całego arkusza. Tego typu zastosowanie wprowadziłem w przykładowym pliku dla Arkusza1. Kod jak widać na pierwszym listingu jest króciutki (listingi odpowiadają kolejno zdarzeniom dla arkuszy 1, 2 i 3 przykładowego pliku będącego załącznikiem punktu).
Tak określone zdarzenie jest mało praktyczne - w zastosowaniu najczęściej interesuje nas modyfikacja tylko wybranego zakresu arkusza lub wywołanie makra przy modyfikacji konkretnych komórek. Tego typu zdarzenia określiłem dla arkusza 2. Określona została zmienna 'Zakres' typu Range. Funkcja VBA 'Intersect' sprawdza czy zakres Target ma wspólne części z obszarem 'Zakres'. Jeżeli funkcja ta zwróci wartość 'Nothing' to oznacza, że zdefiniowane zakresy nie mają wspólnych części. Jeżeli istnieje choć jedna wspólna komórka to funkcja zwróci wartość 'True' (zastosowanie operatora 'Not') i wyświetlony zostanie odpowiedni komunikat. Druga część procedury sprawdza czy zmieniona została tylko komórka A1 lub A2 arkusza (oczywiście można wpisać praktycznie dowolną ilość komórek - również jedną). Jeżeli tak to wykonane zostanie makro o nazwie 'Przyklad' z Module1 pliku. Makro sprowadza się tylko do wyświetlenia komunikatu, ale można np. zdefiniować różne makra uruchamiane przy modyfikacji różnych komórek arkusza.
Ostatnim przedstawianym przykładem zastosowania obsługi zdarzenia Change dla arkusza jest sprawdzenie poprawności danych wprowadzanych do zdefiniowanego zakresu (listing 3). Oczywiście nieco bardziej zaawansowani użytkownicy Excela znają właściwość sprawdzenia poprawności danych Excela bez VBA, ale posiada ona wadę - dane wklejane do komórki nie są sprawdzane, a reguły sprawdzenia poprawności dla tej komórki zostaną usunięte. Wartości wprowadzane do zakresu muszą być liczbami całkowitymi od 1 do 20. Początek procedury jest podobny do listingu 2. W pętli For ... Each przetwarzane są wszystkie komórki zakresu. Komórki są przekazywane jako argument funkcji o nazwie 'Funkcja_sprawdzajaca' (zdefiniowana w obszarze Arkusza 3). Funkcja zwróci do procedury ją wywołującej wartość 'True' jeżeli dane spełniają wymagania lub (jeżeli nie spełniają)łańcuch tekstowy opisujący rodzaj problemu. Jeżeli wprowadzane są dane nieprawidłowe to wyświetlony zostanie komunikat. Po jego zamknięciu komórka zostanie wyczyszczona i ustawiona jako aktywna. Warto tutaj zwrócić uwagę, że wyczyszczenie komórki należy zamknąć w ramki polecenia z wartością logiczną 'Application.EnableEvents'. Polecenie to wyłączy obsługę zdarzeń na czas czyszczenia komórki. Bez niego próba wyczyszczenia danych wywoła zdarzenie Change i powstanie pętla nieskończona. Innym zastosowaniem wyłaczenia obsługi zdarzeń, z którym się spotkałem, jest sytuacja, gdy programowo kopiuję i wklejam dużą liczbę komórek (pojawia się charakterystyczne migotanie ekranu związane właśnie ze zdarzeniami). Wyłączenie obsługi zdarzeń pomoże uporać się z tym czasami irytującym efektem. Warto jeszcze zwrócić uwagę na polecenie 'TypeName' - nieco szerzej opisałem je w punkcie BLOKOWANIE WPROWADZANIA LITER DO TEXTBOX
Przykłady obsługi zdarzeń arkuszy, które zdarzyło mi się wykorzystać w swoich programach przedstawiłem również w artykułach z działu 'Programy do kuchni':
- Ukrywanie arkuszy roboczych programu - obsługa zdarzeń w VBA
- Dostosowanie rozdzielczości pracy aplikacji - obsługa zdarzeń w VBA
Polecam również książkę J. Walkenbach "Excel 2003. Programowanie VBA", w której cały rodział 19 poświęcony jest obsłudze zdarzeń. Z tej książki zaczerpnąłem przytaczane przykłady (z własnymi modyfikacjami i opisami).

Monitorowanie zmiany dowolnej komórki arkusza Kliknij, żeby (roz)winąć listing

Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "Zmieniony zakres: " & Target.Address
End Sub


Zmiana komórki z zakresu, wykonanie makra przy modyfikacji komórki A1 lub A2 Kliknij, żeby (roz)winąć listing

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Zakres As Range
Set Zakres = Range("B7:I20")

If Not Intersect(Target, Zakres) Is Nothing Then
MsgBox "Zmodyfikowano komórkę: " & Target.Address & _
" należącą do zadanego zakresu: " & Zakres.Address
End If

If Not Intersect(Target, Range("A1", "A2")) Is Nothing Then
Call Przyklad
End If
End Sub

Sub Przyklad()
MsgBox "Zmodyfikowano komórkę A1 lub A2, co spowodowało wywołanie" & _
Chr(10) & "makra z Module1 o nazwie 'Przyklad'"
End Sub


Monitorowanie zmiany komórki z zakresu ze sprawdzeniem poprawności danych Kliknij, żeby (roz)winąć listing

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Zakres As Range
Dim Komorka As Range
Dim Komunikat As String
Dim Sprawdzana_zawartosc As Variant

Set Zakres = Range("B7:I20")

'Jeżeli modyfikowana jest komorka poza zakresem wyjście z procedury
If Intersect(Target, Zakres) Is Nothing Then Exit Sub

'Pętla sprawdza wszystkie komórki z obszaru Zakres
For Each Komorka In Intersect(Target, Zakres)
Sprawdzana_zawartosc = Funkcja_sprawdzajaca(Komorka)
If TypeName(Sprawdzana_zawartosc) = "String" Then
Komunikat = "Komórka " & Komorka.Address(False, False) & ":"
Komunikat = Komunikat & Chr(10) & Chr(10) & Sprawdzana_zawartosc

MsgBox Komunikat, vbCritical, "Nieprawidłowa zawartość komórki"

'Wyłaczenie obsługi zdarzeń, by można wyczyścić komórkę
Application.EnableEvents = False
Komorka.ClearContents
Komorka.Activate
Application.EnableEvents = True
End If
Next Komorka

End Sub

Private Function Funkcja_sprawdzajaca(Komorka As Range) As Variant

'Funkcja zwraca zawartość True, jeżeli zawartość komórki to liczba
'całkowita z zakresu 1 do 20
'w przeciwnym wypadku zwraca łańcuch tekstowy String opisujący
'problem

'Czy wprowadzono liczbę
If Not WorksheetFunction.IsNumber(Komorka) Then
Funkcja_sprawdzajaca = "Należy wprowadzić liczbę"
Exit Function
End If

'Czy liczba jest całkowita
If CInt(Komorka) <> Komorka Then
Funkcja_sprawdzajaca = "Należy wprowadzić liczbę całkowitą"
Exit Function
End If

'Czy liczba z zakresu od 1 do 20
If Komorka < 1 Or Komorka > 20 Then
Funkcja_sprawdzajaca = "Należy wprowadzić liczbę całkowitą z zakresu od 1 do 20"
Exit Function
End If

'Wszystkie warunki spełnione
Funkcja_sprawdzajaca = True

End Function

Zdarzenia związane z arkuszem należą do najbardziej przydatnych przy pracy z Excelem. Niektóre zastosowania to np. wywoływanie makra przy modyfikacji wybranego zakresu arkusza (również pojedynczej komórki), zaawansowane sprawdzanie poprawności danych wprowadzanych w zakresie arkusza lub monitorowanie zakresu komórek w celu pogrubienia odpowiednich wartości itp. Załącznikiem tego punktu jest plik 'Zdarzenie_Change' (do ściągnięcia w dziale pliki).

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Sumowanie wartości w komórkach odpowiedniego koloru KLIKNIJ by (roz)winąć

Treść punktu stanowi odpowiedź na zapytanie skierowane przez jednego z użytkowników strony 'czy można w excelu zbudować formułę, które sumowałaby np. tylko komórki w kolorze czerwonym'. Załącznikiem jest plik, w którym zawarłem propozycję zrealizowania tego zadania tzn. sumowania wartości w komórkach o zadanym kolorze.

Działanie pliku:
W arkuszu 1 zawarte są dwa przyciski pod które podpięte są makra.

Przycisk 1 - 'Pokaż numer koloru wypełnienia aktywnej komórki'
w oknie komunikatu program wyświetli indeks koloru aktywnej komórki Excela. W zakresie E3 do E42 zawarłem pokolorowane standardowymi barwami Excela komórki. Kliknięcie na przycisku po aktywowaniu każdej z tych komórek pozwoli poznać numer indeksu pod którym Excel taką komórkę widzi. Jeżeli zaznaczona zostanie komórka nie wypełniona kolorem treść komunikatu zostanie odpowiednio zmieniona.

Przycisk 2 - 'Licz ilość kolorowych komórek i sumę wartości w kolorowych komórkach'
Program pobierze kolor aktywnej w chwili uruchomienia makra komórki i wyświetli odpowiedni komunikat. Jeżeli komórka nie jest wypełniona kolorem działanie makra zostanie przerwane. Jeżeli natomiast aktywna komórka jest wypełniona kolorem program poprosi o podanie zakresu do podliczenia - zaproponowałem zakres G4:G42. Po wybraniu zakresu i użyciu 'Ok.' program wyświetli okno komunikatu podając:
- ilość komórek o przyjętym do działania makra kolorze,
- ilość łączną komórek w zadanym zakresie,
- sumę wartości komórek w zakresie o przyjętym do działania makra kolorze,
/Program domyślnie przyjmuje, że w komórkach znajdują się liczby - zmienna Double/.

Dla sprawdzenia działania makra proponuję:
Krok 1 - aktywować komórkę E18 arkusza 1,
Krok 2 - kliknąć przycisk 'Licz ilość kolorowych komórek _'
Krok 3 - podać zakres od G4 do G42,
Krok 4 - Kliknąć 'OK.' - program wyświetli komunikat o w/w treści

Komórka o kolorze wzorcowym musi znajdować się w obrębie arkusza, jednak podany zakres komórek nie musi być w tym samym arkuszu czy pliku (po wyświetleniu okna z prośbą o określenie zakresu można podać zakres z innego pliku np. dla pliku o nazwie 'Zeszyt2' zakres może być dany zapisem [Zeszyt2]Arkusz1!$A$3:$A$42) co mam nadzieję uczyni plik bardziej elastycznym w ewentualnym wykorzystaniu. Przy wyświetleniu okna z określeniem zakresu inne uruchomione pliki Excela podawałem korzystając z menu 'Okno'.

Gdyby były jakieś problemy, pytania czy propozycje modyfikacji działania makra w załączonym pliku - proszę dać znać. Plik sprawdzałem na Excelu 2003.
Tyle mojej propozycji.

Odnośnie samego pytania:
Formatowaniem warunkowym można uzyskać w Excelu pokolorowanie komórek o wartościach spełniających zadane kryteria (do trzech warunków) - temat ten przedstawiam w dziale 'Porady Excel'. Nie spotkałem się natomiast z formułą czystego Excela pozwalającą zliczyć wartości w komórkach dla zadanego koloru. Wydaje mi się, że w Excelu 2003 nie ma takiej możliwości. Z Excelem 2007 mam mniejszy kontakt (zajmuję się głównie pisaniem aplikacji, a ponieważ Excel 2007 ze swoimi przedłużającymi się chorobami wieku dziecięcego generuje dużą ilość błędów przy zastosowaniach produkcyjnych tego typu to korzystam z niego rzadziej). Jednak biorąc pod uwagę znacznie rozbudowane możliwości formatowania warunkowego w tej wersji arkusza być może są sposoby, aby zrealizować przedstawione zadanie bez użycia makr - jednak ja sam ich nie znam. Jeżeli jednemu z użytkowników strony uda się znaleźć taki sposób proszę dać znać ;)

Makro - sumowanie wartości komórek określonego koloru Kliknij, żeby (roz)winąć listing

Sub Pokaz_index()

Dim Index_koloru As Variant
Index_koloru = Selection.Interior.ColorIndex

If Index_koloru = -4142 Then
MsgBox "Komórka " & Selection.Address & " nie jest wypełniona kolorem - wartość indeksu to -4142"
Else
MsgBox "Indeks koloru aktywnej komórki " & Selection.Address & " to: " & Index_koloru
End If

End Sub

Sub Licz_kolorowe()

Dim Zaznaczony_obszar As Range
Dim Licznik_koloru As Integer
Dim Licznik_wszystkich As Integer
Dim Wartość_kolorowych As Double
Dim Index_koloru As Variant

Index_koloru = Selection.Interior.ColorIndex
Licznik_koloru = 0
Wartość_kolorowych = 0

If Index_koloru = -4142 Then
MsgBox "Komórka " & Selection.Address & " aktywna w chwili uruchomienia makra nie jest wypełniona kolorem." & Chr(10) & _
"Procedura zostanie zakończona"
Exit Sub
Else
MsgBox "Indeks koloru aktywnej komórki " & Selection.Address & " to: " & Index_koloru & Chr(10) & _
"Ten kolor będzie szukany"
End If

Adres_obszaru = Selection.Address

On Error GoTo Przerwa

Set Zaznaczony_obszar = Application.InputBox _
(Prompt:="Podaj zakres do zliczenia kolorowych komórek i ich wartości", _
Title:="Liczenie ilości i wartości kolorowych komórek", _
Default:=Adres_obszaru, _
Type:=8)

For Each Cell In Zaznaczony_obszar
Licznik_wszystkich = Licznik_wszystkich + 1
If Cell.Interior.ColorIndex = Index_koloru Then
Licznik_koloru = Licznik_koloru + 1
Wartość_kolorowych = Wartość_kolorowych + Cell.Value
End If
Next Cell

MsgBox "Dane dla zakresu: " & Zaznaczony_obszar.Address & Chr(10) & _
"Liczba komórek o indeksie koloru: " & Index_koloru & _
" wynosi: " & Licznik_koloru & " szt." & Chr(10) & _
"Liczba wszystkich komórek: " & Licznik_wszystkich & " szt." & Chr(10) & _
"Wartość w komórkach o wybranym kolorze wynosi: " & Wartość_kolorowych

Exit Sub
Przerwa:

End Sub

Treść punktu stanowi odpowiedź na zapytanie skierowane przez jednego z użytkowników strony 'czy można w excelu zbudować formułę, które sumowałaby np. tylko komórki w kolorze czerwonym'. Załącznikiem jest plik 'Licz_kolorowe', w którym zawarłem propozycję zrealizowania tego zadania tzn. sumowania wartości w komórkach o zadanym kolorze (do ściągnięcia w dziale pliki).
UWAGA
Przygotowałem samodzielną wtyczkę rozszerzającą możliwości Excela między innymi o funkcje i instrukcje zliczania wartości i ilości komórek wg ich koloru - opis na stronie Dodatek_GK. Zastosowanie wtyczki nie wymaga umiejętności programowania.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Makra do sortowania tablic z poziomu VBA KLIKNIJ by (roz)winąć

Excel posiada wbudowane narzędzie dotyczące sortowania zakresów komórek arkusza, ale sam język VBA nie dysponuje metodą sortowania tablic. Wg podręcznika J. Walkenbacha dostępne są cztery metody procedur sortujących pisanych w VBA:
- sortowanie arkuszowe - polega na przeniesieniu zawartości tablicy do zakresu arkusza, posortowaniu jej, a następnie ponownym umieszczeniu w tablicy. Procedura oparta na tej metodzie dla Excela 2003 obsługuje do 65536 elementów (liczba wierszy w arkuszu). Dla Excela 2007 ilość ta została znacznie zwiększona,
- sortowanie bąbelkowe - łatwe w kodowaniu, ale powolne (ma to znaczenie przy większych tablicach). W skrócie dla sprawdzenia każdego elementu tablicy wykonywana jest zagnieżdżona pętla For ... Next. Jeśli określony element tablicy jest większy od następnego, oba elementy zamieniają się miejscami. Operacja jest powtarzana dla każdej pary elementów, czyli n-1 razy,
- sortowanie szybkie - może być wykorzystane przy typach danych Integer lub Long,
- sortowanie zliczające.

W książce Walkenbacha znajduje się tabela porównująca szybkość algorytmów sortujących dla tablic wielkości 100, 500, 1000, 5000, 10000, 50000, 100000. Z porównania wynika, że sortowanie bąbelkowe sprawdza się w tablicach do 5000 elementów. Dla tablicy 10000 elementów czas sortowania wyniósł już 14,55 s co w praktyce pisania samodzielnych aplikacji nie jest do zaakceptowania. Czas sortowania tablicy zawierającej 50000 elementów dla algorytmu sortowania arkuszowego wyniósł 0,95 s. Sortowania szybkie i zliczające były najbardziej efektywne (zwłaszcza zliczające - czas sortu tablicy 100000 elementów wyniósł tylko 0,17s). Oczywiście wszystkie czasy zależne są od konfiguracji sprzętu i mają znaczenie tylko dla porównania poszczególnych algorytmów.
W tym punkcie chciałbym przedstawić tylko sortowanie arkuszowe i bąbelkowe (osobom zainteresowanym pozostałymi dwoma metodami polecam bardziej zaawansowaną literaturę). Ich zaletami są łatwość kodowania i stosunkowo wysoka efektywność. Przy tablicach do 5000 elementów różnica szybkości wykonania dla pozostałych algorytmów jest w mojej praktyce pomijalna, a zwiększona ilość wierszy w Excelu 2007 czyni sortowanie arkuszowe interesującą alternatywą. Tak więc w oparciu o te dwa typy sortowania mam możliwość zaproponowania rozwiązania dla interesujących mnie zagadnień.

W przykładowym pliku zawarte są dwa przyciski - jeden dla algorytmu sortowania bąbelkowego, drugi dla algorytmu sortowania arkuszowego. Obydwa algorytmy przeprowadzane są w oparciu o sortowanie tablicy jednowymiarowej dla podanej przez użytkownika ilości elementów (program losuje liczby całkowite w zakresie 0 do 1000 i wypełnia nimi tablicę). Procedury mierzą czas (polecenie Timer) i na zakończenie działania podają w oknie komunikatu wyniki pracy. Co ważne w przypadku sortowania tablicy zawierającej dane tekstowe poniższa procedura będzie rozróżniać duże i małe litery co nie zawsze jest zgodne z oczekiwaniami użytkownika. Walkenbach proponuje w tym miejscu albo zamienić wszystkie znaki na duże litery (polecenie UCase) albo przed procedurą umieścić instrukcję Option Compare Text (interpreter VBA wykonuje operację porównania łańcuchów tekstowych bez uwzględniania wielkości znaków).

Poniżej przedstawiam procedurę dla sortowania bąbelkowego wraz z omówieniem oraz procedurę sortowania arkuszowego wraz z omówieniem. Warto zwrócić uwagę na polecenie Option Base 1 przed procedurą. Dzięki niemu interpreter VBA za dolny indeks tablicy przyjmuje liczbę 1 (standardowo jest to 0). Bez tego polecenia deklaracja "Dim Moja_tablica(100) As Integer" dotyczy tablicy o ilości elementów 101. Więcej informacji w książkach Walkenbacha i Halvorsona.
Porównanie prędkości obydwu procedur:
- dla tablicy 5000 elementów
    sortowanie bąbelkowe: 0,58 s
    sortowanie arkuszowe: 0,06 s
- dla tablicy 10000 elementów
    sortowanie bąbelkowe: 2,00 s
    sortowanie arkuszowe: 0,11 s
- dla tablicy 15000 elementów,
    sortowanie bąbelkowe: 4,25 s
    sortowanie arkuszowe: 0,16 s
- dla tablicy 50000 elementów
    sortowanie bąbelkowe: 43,06 s
    sortowanie arkuszowe: 0,53 s

Jak widać wygoda stosowania sortowania bąbelkowego kończy się gdzieś między wartościami 5000 a 10000 elementów w tablicy. Sortowanie arkuszowe wygląda przyzwoicie również przy tablicach większych i w zwykłych aplikacjach jest to procedura, pod względem szybkości, całkowicie wystarczająca.

Makro do sortowania bąbelkowego Kliknij, żeby (roz)winąć listing

Option Base 1

Sub Sortowanie_bąbelkowe()

Dim i As Long
Dim j As Long
Dim Tablica_sortowana() As Double
Dim Tymczasowy As Double
Dim Ilość_elementów As Long
Dim Pierwszy As Long
Dim Ostatni As Long
Dim Czas_start As Double
Dim Wyniki_czas As Long

Randomize

On Error GoTo Komunikat

'Zamrożenie aktualizacji ekranu - przyspiesza działanie procedury
Application.ScreenUpdating = False

'Pobranie ilości elementów tablicy - tylko liczby całkowite w zakresie zmiennej typu Long
Ilość_elementów = InputBox("Podaj ilość elementów do sortowania", "Sortowanie bąbelkowe", "5000")

'Zmiana wielkości tablicy w zależności od podanej ilości elementów
ReDim Tablica_sortowana(1 To Ilość_elementów)

'Wypełnienie tablicy wartościami losowymi
For i = 1 To Ilość_elementów
Tablica_sortowana(i) = Int(Rnd() * 1000)
Next

'Początek pomiaru czasu
Czas_start = Timer

'Pobranie kolejno pierwszego i ostatniego elementu tablicy
Pierwszy = LBound(Tablica_sortowana)
Ostatni = UBound(Tablica_sortowana)

'Procedura sortowania bąbelkowego
For i = Pierwszy To Ostatni - 1
    For j = i + 1 To Ostatni
     If Tablica_sortowana(i) >= Tablica_sortowana(j) Then
     Tymczasowy = Tablica_sortowana(j)
     Tablica_sortowana(j) = Tablica_sortowana(i)
     Tablica_sortowana(i) = Tymczasowy
     End If
    Next j
Next i

'Odmrożenie odświeżania ekranu
Application.ScreenUpdating = True

'Podanie wyników w oknie komunikatu
Wyniki_czas = MsgBox("Ilość elementów tablicy: " & vbTab & vbTab & Ilość_elementów & vbCrLf & _
"Czas sortowania w sekundach: " & vbTab & Format(Timer - Czas_start, "0.00"), vbOKOnly, "Sortowanie bąbelkowe - wyniki")

Exit Sub
Komunikat:
Opis = MsgBox("Błąd wartości - można wprowadzać tylko liczby całkowite", vbCritical + vbOKOnly, "Sortowanie bąbelkowe")
End Sub


Makro do sortowania arkuszowego Kliknij, żeby (roz)winąć listing

Option Base 1

Sub Sortowanie_arkuszowe()

Dim i As Long
Dim Tablica_sortowana() As Double
Dim Ilość_elementów As Long
Dim Ostatni As Long
Dim Czas_start As Double
Dim Obszar_arkusza As Range
Dim Wyniki_czas As Long

Randomize

On Error GoTo Komunikat

'Zamrożenie aktualizacji ekranu - przyspiesza działanie procedury
Application.ScreenUpdating = False

'Pobranie ilości elementów tablicy - tylko liczby całkowite w zakresie zmiennej typu Long
Ilość_elementów = InputBox("Podaj ilość elementów do sortowania", "Sortowanie arkuszowe", "5000")

'Czyszczenie kolumny służącej do sortowania
Arkusz2.Columns("B:B").ClearContents

'Zmiana wielkości tablicy w zależności od podanej ilości elementów
ReDim Tablica_sortowana(1 To Ilość_elementów)

'Wypełnienie tablicy wartościami losowymi
For i = 1 To Ilość_elementów
Tablica_sortowana(i) = Int(Rnd() * 1000)
Next

'Początek pomiaru czasu
Czas_start = Timer

'Pobranie ostatniego elementu tablicy
Ostatni = UBound(Tablica_sortowana)

'Ustawienie obszaru do wklejenia tablicy. Tranpozycja wynika z tego by dane z tablicy nie były
'wstawiane w poziomie zamiast w pionie
Set Obszar_arkusza = Range(Arkusz2.Cells(1, 2), Arkusz2.Cells(Ostatni, 2))
Obszar_arkusza.Value = Application.WorksheetFunction.Transpose(Tablica_sortowana)

'Polecenie sortowania arkuszowego - standardowe polecenie Excela
Obszar_arkusza.Sort Key1:=Arkusz2.Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
   DataOption1:=xlSortTextAsNumbers

'Wczytanie posortowanego arkusza z powrotem do tablicy
For i = 1 To Ilość_elementów
Tablica_sortowana(i) = Arkusz2.Cells(i, 2)
Next

'Odmrożenie odświeżania ekranu
Application.ScreenUpdating = True

'Podanie wyników w oknie komunikatu
Wyniki_czas = MsgBox("Ilość elementów tablicy: " & vbTab & vbTab & Ilość_elementów & vbCrLf & _
"Czas sortowania w sekundach: " & vbTab & Format(Timer - Czas_start, "0.00"), vbOKOnly, "Sortowanie arkuszowe - wyniki")

Exit Sub
Komunikat:
Opis = MsgBox("Błąd wartości - można wprowadzać tylko liczby całkowite", vbCritical + vbOKOnly, "Sortowanie arkuszowe")
End Sub


W punkcie wymienione zostały metody sortowania tablic dostępne w Visual Basicu. Omówione zostały dwie podstawowe: sortowanie bąbelkowe i sortowanie arkuszowe. Załącznikiem punktu jest plik z przykładowymi algorytmami, których listingi zaprezentowano wyżej - do ściągnięcia w dziale pliki). W algorytmy wbudowano pomiar czasu co pomoże porównać obydwie procedury pod względem szybkości działania przy sortowaniu tablic różnej wielkości. Więcej na ten temat można znaleźć w książce Walkenbacha, prezentowanej na niniejszej witrynie.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Wywoływanie procedur zastosowanie instrukcji Call KLIKNIJ by (roz)winąć

Bardzo często zachodzi potrzeba by w użytkowanej aplikacji nanieść zmiany lub uzupełnienia. Pierwsze próby wprowadzania tej instrukcji realizowałem gdy kod pojedynczego makra był zbyt długi i interpreter odmawiał jego wykonania. Dzieliłem wtedy pierwotny kod na części i wywoływałem. Instrukcję Call można wykorzystać dużo lepiej i przy odpowiednim zastosowaniu uzyskać znaczne uporządkowanie kodu ułatwiające budowanie kolejnych wersji programów. Zastosowanie "Call" jest opcjonalne (można wywołać procedurę przez podanie tylko jej nazwy) jednak czytelność wymaga by zawsze używać tej instrukcji. Instrukcję Call można stosować w postaci:
- Call bez podania argumentów,
wywołanie procedury bez podania zmiennych, po wykonaniu wywoływanej procedury program kontynuuje wykonywanie procedury wywołującej. Procedura wywoływana musi mieć jednoznaczną nazwę tzn. unikalną w zakresie skoroszytu.
Call Nazwa_procedury()

Przykład 1
Sub Procedura_wywołująca()
Dim Komunikat As String
Komunikat = "Instrukcja Call bez podania argumentów" & vbCrLf & "Procedura wywołująca"
MsgBox Komunikat
Call Procedura_wywoływana
End Sub

Sub Procedura_wywoływana()
Dim Komunikat As String
Komunikat = "Instrukcja Call bez podania argumentów" & vbCrLf & "Procedura wywoływana"
MsgBox Komunikat
End Sub

- Call z podaniem argumentów,
wywoływanie procedury z podaniem nazw zmiennych, procedura wywoływana może modyfikować wartość zmiennych i taką zaktualizowaną przekazać do procedury wywołującej Procedura wywoływana musi mieć jednoznaczną nazwę tzn. unikalną w zakresie skoroszytu.
Call Nazwa_procedury(zmienna_1, zmienna_2)

Przykład:
Sub Procedura_wywołująca()
Dim Komunikat As String
Komunikat = "Instrukcja Call z podaniem argumentu" & vbCrLf & "Procedura wywołująca"
MsgBox Komunikat
Call Procedura_wywoływana(Komunikat)
End Sub

Sub Procedura_wywoływana(Komunikat As String)
MsgBox Komunikat & vbCrLf & "KOMUNIKAT Z PROCEDURY WYWOŁYWANEJ"
Komunikat = "Instrukcja Call z podaniem argumentu" & vbCrLf & "Procedura wywoływana"
MsgBox Komunikat
End Sub

- Call z podaniem wartości argumentów,
W wywoływanej procedurze przy deklaracji argumentów należy użyć słowa ByVal. W tej sytuacji interpreter tworzy w procedurze kopię zmiennej nie zmieniając samej zmiennej w procedurze wywołującej. Pracuje na wartości zmiennej, a nie na niej samej.

Przykład:
Sub Procedura_wywołująca()
Dim Komunikat As String
Komunikat = "Instrukcja Call z podaniem argumentu" & vbCrLf & "Procedura wywołująca"
MsgBox Komunikat
Call Procedura_wywoływana(Komunikat)
MsgBox Komunikat
End Sub

Sub Procedura_wywoływana(ByVal Komunikat As String)
MsgBox Komunikat & vbCrLf & "KOMUNIKAT Z PROCEDURY WYWOŁYWANEJ"
Komunikat = "Instrukcja Call z podaniem argumentu" & vbCrLf & "Procedura wywoływana"
MsgBox Komunikat
End Sub

- Call z podaniem nazwy modułu
W sytuacji gdy w skoroszycie, w kilku modułach znajduje się makro o tej samej nazwie należy wskazać nazwę makra poprzedzaną nazwą modułu w którym makro się znajduje
Call Module1.Nazwa_procedury

Przykład:
Sub Procedura_wywołująca()
Dim Komunikat As String
Komunikat = "Instrukcja Call z podaniem argumentu" & vbCrLf & "Procedura wywołująca"
MsgBox Komunikat
Call Module2.Procedura_wywoływana(Komunikat)
MsgBox Komunikat
End Sub

Sub Procedura_wywoływana(ByVal Komunikat As String)
MsgBox Komunikat & vbCrLf & "KOMUNIKAT Z PROCEDURY WYWOŁYWANEJ"
Komunikat = "Instrukcja Call z podaniem argumentu" & vbCrLf & "Procedura wywoływana z modułu 2"
MsgBox Komunikat
End Sub

Sub Procedura_wywoływana(ByVal Komunikat As String)
MsgBox Komunikat & vbCrLf & "KOMUNIKAT Z PROCEDURY WYWOŁYWANEJ"
Komunikat = "Instrukcja Call z podaniem argumentu" & vbCrLf & "Procedura wywoływana z modułu 3"
MsgBox Komunikat
End Sub

Główne przyczyny używania polecenia Call (wywoływania procedur z innych procedur) to:
- przejrzystość kodu źródłowego
Procedurę w postaci:

Sub Analiza
Call Zebranie_danych ()
Call Wstawienie_do_tablic ()
Call Sortowanie_tablic ()
Call Przygotowanie_tabeli ()
Call Wydruk_tabeli ()
End Sub

Z procedurami składowymi w różnych modułach dużo łatwiej przeanalizować, uzupełnić bądź poprawić.
- zmniejszenie ilości kodu
Jeżeli wielokrotnie w różnych makrach wykonujemy tę samą operację można ją zapisać raz i później tylko wielokrotnie wywoływać.

Opisany wyżej sposób budowania programu bardzo ułatwia pracę przy ewentualnej rozbudowie: naniesienie uzupełnień do jednego programów (z intensywnie stosowaną instrukcją Call) zajęło mi około czterech dni, podczas gdy w innym programie (w jednym z pierwszych w którym nie zadbałem o odpowiednie zastosowanie wywoływania procedur) szybciej jest przepisać program na nowo porządkując kod niż nanosić uzupełnienia w istniejących algorytmach.

Przykład rzeczywistej procedury z programu WINDYKACJA Kliknij, żeby (roz)winąć listing

Private Sub CommandButton_Druk_Niedoplaty_Click()

Dim Komunikat As Integer

On Error GoTo Obsluga_bledu

Application.ScreenUpdating = False 'blokowanie odświeżania ekranu

Arkusz2.Range("H4").Value = CStr(TextBox_Granica.Value)

UserForm8.Show

'WYCZYSZCZENIE ZAWARTOŚCI TABELI CZYSTEJ
Arkusz5.Range("C6:C2780").ClearContents
Arkusz5.Range("D6:D2780").ClearContents
Arkusz5.Range("E6:E2780").ClearContents
Arkusz5.Range("F6:F2780").Value = CCur(Format(0, "0.#0"))
Arkusz5.Range("G6:G2780").Value = "N"
Arkusz5.Range("H6:H2780").Value = CCur(Format(0, "0.#0"))
Arkusz5.Range("I6:I2780").Value = "N"
Arkusz5.Range("K6:K2780").ClearContents
Arkusz5.Range("L6:L2780").ClearContents
Arkusz5.Range("M6:M2780").ClearContents
Arkusz5.Range("U6:U2780").ClearContents

'WYWOŁYWANIE PROCEDUR ZEWNĘTRZNYCH

'Wstawienie dat pisma
Call Wstaw_daty_niedoplata 'Podprocedura z modułu 7

'Kopiowanie zakresów tabel z miesiąca brudnego do czystej
Call Kopiowanie_niedoplata 'Podprocedura z modułu 7

'Wypełnienie pism
Call Drukuj_niedoplaty 'Podprocedura z modułu 8

'Kopiowanie przyczyn do tabeli głównej
Call Powrot_przyczyn_niedoplaty 'Procedura z modułu 9

CommandButton_Druk_Niedoplaty.ForeColor = &H8000&

Application.ScreenUpdating = True 'odblokowanie odświeżania ekranu

Exit Sub

Obsluga_bledu:
Komunikat = MsgBox("Wystąpił błąd - zgłoś autorowi programu" & Chr(10) & _
"Przy zgłoszeniu proszę podać opis zjawiska ;)", vbInformation + vbOKOnly, "WINDYKACJA KORESPONDENCJA v 1.0")
End Sub

W punkcie przedstawiono polecenie wywoływania procedury z innej procedury 'Call' wraz ze wskazaniem w jaki sposób można zastosować tę instrukcję do porządkowania kodu programów. Podano przykłady krótkich makr realizujących wywoływanie procedur Sub z różnych modułów, z podaniem i bez podania zmiennej lub ze skopiowaniem samej wartości zmiennej. W bardziej rozbudowanych aplikacjach zastosowanie instrukcji 'Call' jest niezbędne dla efektywnego zarządzania kodem programu.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Działania na zakresach metoda 'SpecialCells' obiektu 'Range' KLIKNIJ by (roz)winąć

W książce Walkenbacha znalazłem ciekawe przetwarzanie komórek używanego zakresu. Autor w używanym zakresie wydziela podzbiory przy użyciu metody SpecialCells. Dokładne dane o metodzie SpecialCells obiektu Range można znaleźć w pomocy VBA. Metoda przyjmuje dwa argumenty: typ komórki i opcjonalnie wartość, a zwraca wszystkie komórki w bieżącym zakresie, które zawierają jakiś specjalny atrybut zdefiniowany przez parametr Type.
Niektóre rodzaje typów:
- xlCellTypeBlanks - komórki puste,
- xlCellTypeComments - komórki zawierające komentarze,
- xlCellTypeConstants - komórki zawierające wartości (nie formuły)
- xlCellTypeFormulas - komórki zawierające formuły,
- xlCellTypeLastCell - ostatnia używana komórka w zakresie,
- xlCellTypeVisible - komórki widoczne,

Rodzaje wartości (opcjonalne):
- xlErrors - komunikaty o błędach,
- xlLogical - wartości logiczne,
- xlNumbers - wartości liczbowe,
- xlTextValues - wartości tekstowe,

Przykładowa procedura w zakresie używanym arkusza (UsedRange) wydziela kilka podzbiorów, które odpowiednio koloruje. Komórki podzbiorów przetwarzane są w pętlach For Each ... Next i w części wypadków zagnieżdżonych If ... Then. Przetwarzane są tylko komórki spełniające dane kryteria, dzięki czemu uzyskuje się znaczne przyspieszenie działania makra. Warto zwrócić uwagę, że metoda SpecialCells zwraca błąd przy pustym zakresie i dlatego konieczne jest zastosowanie polecenia ignorowania błędów. Dla Excela komórki sformatowane i odblokowane również zawierają informacje. Poniżej przedstawiam listing kodu wraz z komentarzami.
Widok zakresu arkusza przed wykonaniem makra:

Widok zakresu arkusza po wykonaniu makra:


Mała uwaga:
Dla Excela data jest liczbą. Jeżeli chcemy wykonać operacje czyszczenia zawartości na samych liczbach bez dat należy użyć następującego kodu:

On Error Resume Next
For Each Tylko_liczby In Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
If Not IsDate(Tylko_liczby.Value) Then Tylko_liczby.ClearContents
Next Tylko_liczby

Więcej informacji na temat przetwarzania zakresów znajduje się w książce Walkenbacha oraz podręczniku "Excel 2007 pl. Programowanie VBA" przedstawianych na tej stronie.
Przykład jest mojego własnego autorstwa, ale wzorowany na książce Walkenbacha.

Przykład metody 'SpecialCells' Kliknij, żeby (roz)winąć listing

Sub Zakresy()

'Definicja zmiennych typu Range - zakresy komórek
Dim Komórka As Range
Dim Komórka_Formuła As Range
Dim Komórka_Liczba As Range
Dim Komórka_Komentarz As Range
Dim Komórka_Pusta As Range
Dim Komórka_Tekst As Range

'Definicja stałych - kolory
Const Index_Kolor_Formuła = 3 'czerwony
Const Index_Kolor_Liczba = 8 'błękitny
Const Index_Kolor_Komentarz = 7 'fioletowy
Const Index_Kolor_Pusta = 10 'ciemnozielony
Const Index_Kolor_Tekst = 9 'bordowy

'Ignorowanie błędów - konieczne, ponieważ
'metoda SpecialCells generuje błąd przy braku wartości w zakresie
On Error Resume Next

'Zamrożenie ekranu
Application.ScreenUpdating = False

'Wydzielenie podzbiorów w zakresie używanym arkusza
Set Komórka_Formuła = Arkusz1.UsedRange.SpecialCells(xlCellTypeFormulas, xlNumbers) 'Komórki z formułą
Set Komórka_Liczba = Arkusz1.UsedRange.SpecialCells(xlCellTypeConstants, xlNumbers) 'Komórki z liczbą
Set Komórka_Komentarz = Arkusz1.UsedRange.SpecialCells(xlCellTypeComments) 'Komórki z komentarzem
Set Komórka_Pusta = Arkusz1.UsedRange.SpecialCells(xlCellTypeBlanks) 'Komórki puste
Set Komórka_Tekst = Arkusz1.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues) 'Komórki z tekstem

'Przetwarzanie komórek z formułami /z wynikami formuł <= 10/
If Not Komórka_Formuła Is Nothing Then
  For Each Komórka In Komórka_Formuła
    If Komórka.Value <= 10 Then     Komórka.Interior.ColorIndex = Index_Kolor_Formuła
    Else
    Komórka.Interior.ColorIndex = xlNone
    End If
  Next Komórka
End If

'Przetwarzanie komórek z liczbami - bez wyników formuł /liczby >=10 i <=1/
If Not Komórka_Liczba Is Nothing Then
  For Each Komórka In Komórka_Liczba
    If Komórka.Value >= 10 Or Komórka.Value <= 1 Then
    Komórka.Interior.ColorIndex = Index_Kolor_Liczba
    Else
    Komórka.Interior.ColorIndex = xlNone
    End If
  Next Komórka
End If

'Przetwarzanie komórek pustych /uwzględnia komórki z komentarzem, ale bez wartości/
If Not Komórka_Pusta Is Nothing Then
  For Each Komórka In Komórka_Pusta
  Komórka.Interior.ColorIndex = Index_Kolor_Pusta
  Next Komórka
End If

'Przetwarzanie komórek z komentarzem
If Not Komórka_Komentarz Is Nothing Then
  For Each Komórka In Komórka_Komentarz
  Komórka.Interior.ColorIndex = Index_Kolor_Komentarz
  Next Komórka
End If

'Przetwarzanie komórek z tekstem
If Not Komórka_Tekst Is Nothing Then
  For Each Komórka In Komórka_Tekst
  Komórka.Interior.ColorIndex = Index_Kolor_Tekst
  Next Komórka
End If

Application.ScreenUpdating = True

End Sub

W punkcie przedstawiono efektywne przetwarzanie zakresów arkusza Excela z wykorzystaniem metody 'SpecialCells' obiektu 'Range' tj. wydzieleniem w danym zakresie, zbiorów komórek spełniających zadane kryteria. W dalszej części procedury w pętlach For Each ... Next można przetwarzać tylko zdefiniowane w ten sposób podzakresy. Korzyści to między innymi znaczne przyspieszenie kodu. W przykładowym listingu wykorzystano 'UsedRange' tj. zakres używany arkusza, zamiast wskazania adresowego.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Graficzny pasek postępu wykonania zadania KLIKNIJ by (roz)winąć

Dla długo działających makr istnieje potrzeba informowania użytkownika o postępie w wykonaniu makra. Najprostszy sposób to użycie w tym celu komunikatów na pasku stanu aplikacji Excel:
Application.StatusBar = "Zaawansowanie makra: " & Procent & " %"
i po zakończeniu działania makra przywrócenie stanu początkowego wg następującej instrukcji:
Application.StatusBar = False
Większość użytkowników Excela nie jest przyzwyczajona do korzystania z paska stanu i oczekuje paska postępu w postaci graficznej.
Podręcznik Walkenbacha dzieli tego typu wskaźniki na trzy kategorie:
- wskaźniki dla makr, które nie są inicjowane przez formularz UserForm (samodzielny wskaźnik postępu),
- wskaźniki dla makr inicjowanych przez formularz UserForm (wykorzystują kontrolkę MultiPage z ukrytymi zakładkami - właściwość Style na 2 - fmTabstyleNone i w momencie wykonywania makra ustawiają właściwość Value na zakładkę z grafiką wskaźnika),
- makr inicjowanych przez formularz UserForm zwiększających w chwili wykonania makra wysokość formularza, ujawniając w ten sposób wskaźnik graficzny, wcześniej ukryty,
W tym punkcie przedstawiam wskaźnik postępu dla samodzielnego makra (nie wywoływanego przez UserForm).
Najpierw zbudowałem formularz wykorzystując:
- kontrolkę Frame - bez ramki i bez napisu,
- wewnątrz Frame ustawiłem Label z pustą właściwością Caption, ale z kolorem tła ustawionym na meksykańską czerwień ;) Całkowita szerokość kontrolki to 307
- kontrolkę Label z tytułem (napis nad wskaźnikiem),
- kontrolkę Label ze stopiniem zaawansowania (napis pod wskaźnikiem)
Przy aktywacji formularza następuje wywołanie makra:
Private Sub UserForm_Activate()
Call Procent_zaawansowania
End Sub
Zdarzenie określone dla aktywacji, a nie dla inicjalizacji. To drugie zdarzenie następuje przed wyświetleniem formularza.
Przykład jest mojego własnego autorstwa, ale wzorowany na książce Walkenbacha.
W procedurze następuje ustawienie szerokości kontrolki Label i zmiana napisu na drugiej kontrolce Label (w pętli With _ End With). Niezbędne dla osiągnięcia zamierzonego efektu podczas wykonania procedury jest zastosowanie metody Repaint formularza UserForm - bez tej instrukcji wyświetlona zostałaby tylko ostatnia zmiana w wyglądzie formularza. Ostatnia instrukcja (Unload) usuwa z pamięci UserForm wskaźnika. Dodatkowo w kodzie umieściłem aktualizację komunikatu na pasku stanu oraz pomiar czasu wykonania makra. Wynik pomiaru wyświetlany jest w ostatnim komunikacie. Jeżeli w trakcie wykonania makra włączy się autozapis Excela aktualizacja wyglądu wskaźnika się 'zatnie' - należałoby przed wykonaniem makra wyłączyć funkcję autozapisu.

Przykład paska postępu Kliknij, żeby (roz)winąć listing

'ZDARZENIE DLA MODUŁU
Private Sub UserForm_Activate()
Call Procent_zaawansowania
End Sub

'PROCEDURA GŁÓWNA
Option Base 1

Sub Procent_zaawansowania()

Dim i As Long
Dim j As Long
Dim Tablica_sortowana() As Double
Dim Tymczasowy As Double
Dim Ilość_elementów As Long
Dim Pierwszy As Long
Dim Ostatni As Long
Dim Czas_start As Double

On Error Resume Next
Randomize

'Zamrożenie aktualizacji ekranu - przyspiesza działanie procedury
Application.ScreenUpdating = False

'Ustawienie napisu na pasku postępu Excela
Application.StatusBar = "Proszę czekać ...."

'Pobranie ilości elementów tablicy - tylko liczby całkowite w zakresie zmiennej typu Long
Ilość_elementów = 35000

'Zmiana wielkości tablicy w zależności od podanej ilości elementów
ReDim Tablica_sortowana(1 To Ilość_elementów)

'Wypełnienie tablicy wartościami losowymi
For i = 1 To Ilość_elementów
Tablica_sortowana(i) = Int(Rnd() * 1000)
Next

'Początek pomiaru czasu
Czas_start = Timer

'Pobranie kolejno pierwszego i ostatniego elementu tablicy
Pierwszy = LBound(Tablica_sortowana)
Ostatni = UBound(Tablica_sortowana)

'Ustawienie napisu na formularzu
UserForm1.Label_tytuł.Caption = "Sortowanie bąbelkowe tablicy " & Ilość_elementów & " elementów"
UserForm1.Repaint

'Procedura sortowania bąbelkowego
For i = Pierwszy To Ostatni - 1

'Aktualizacja napisu na pasku postępu Excela
Procent = Format(i / Ilość_elementów * 100, "0.#0")
Application.StatusBar = "Procent zawansowania: " & Procent & "%"

'Aktualizacja dłg paska postępu /kontrolka Label/ w formularzu UserForm
With UserForm1
  .Label_Postęp_Napis.Caption = "Procent zawansowania: " & Procent & "%"
  .Label_Postęp.Width = i / Ilość_elementów * 308
  .Repaint
End With
   For j = i + 1 To Ostatni
    If Tablica_sortowana(i) > Tablica_sortowana(j) Then
    Tymczasowy = Tablica_sortowana(j)
    Tablica_sortowana(j) = Tablica_sortowana(i)
    Tablica_sortowana(i) = Tymczasowy
    End If
   Next j
   Next i

'Ostateczne ustalenie dłg paska postępu - Label
With UserForm1
  .Label_Postęp_Napis.Caption = "Procent zawansowania: " & 100 & "%"
  .Label_Postęp.Width = 308
  .Repaint
End With

'Odmrożenie odświeżania ekranu i wyłączenie napisu na pasku stanu Excela
Application.ScreenUpdating = True
Application.StatusBar = False

'Podanie wyników w oknie komunikatu
MsgBox "Koniec zadania" & Chr(10) & "Czas sortowania w sekundach: " & Format(Timer - Czas_start, "0.00"), vbInformation, "Pasek postępu aplikacji Excel"
Unload UserForm1
End Sub

'WYWOŁANIE FORMULARZA'
Sub Pasek_postepu()
UserForm1.Show
End Sub


W punkcie przedstawiono propozycje wykonania paska postępu zadania dla długo działających makr aplikacji Excel. Wykonany jest on jako osobny formularz wykorzystujący kontrolki Frame i Label. Przeznaczony jest do wykorzystania dla makr samodzielnie uruchamianych. Pasek postępu zaproponowano dla makra wykonującego sortowanie bąbelkowe tablicy 35000 elementów. W zależności od szybkości komputera sortowanie trwa od kilku do kilkudziesięciu sekund. W trakcie wykonania makro aktualizuje zarówno formularz zawierający wskaźnik postępu jak i komunikat na pasku stanu. Wykonanie makra jest mojego autorstwa, ale wzorowane na książce Walkenbacha, która zawiera również inne sposoby wykonania wskaźnika postępu. W dziale pliku znajduje się plik z przykładem przedstawianym w tym punkcie.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Funkcje i interfejs Windows API KLIKNIJ by (roz)winąć

Możliwości języka VBA zastosowanego w ramach programu Excel są ograniczone do czynności, które ten program może wykonać. Aby odwołać się do czynności standardowo wykonywanych przez system Windows (np. określenie aktualnej rozdzielczości karty graficznej, dodawanie dźwięków do aplikacji itp.) można skorzystać funkcji API (Application Programming Interface). Jest to zbiór funkcji dostępnych dla osób wykonujących aplikacje pod Windows dostępnych z poziomu bibliotek DLL. Większość osób korzysta z funkcjami interfejsu API jako gotowymi procedurami kopiując deklaracje i funkcje bez zagłębiania się w szczegóły. Zastosowanie tego typu funkcji przekracza zakres tematyczny tej strony. Ograniczę się do podania gotowych funkcji znalezionych w literaturze i sieci. Większość punktu przygotowana została w oparciu o książkę pana Walkenbacha przedstawianą na stronie. Dla rozszerzenia informacji o zastosowaniu funkcji API w Excelu zachęcam do zapoznania się z tą pozycją.
Uwaga:
Funkcje API są przypisane do rodzaju aplikacji np. jeżeli Excel 97 jest aplikację 16-bitową, a Excel 2003 32-bitową to funkcje API działające w jednej aplikacji nie będą działały w drugiej. Przed użyciem funkcji API konieczne jest jej zadeklarowanie na początku modułu kodu źródłowego (jeżeli moduł kodu źródłowego nie jest standardowym modułem VBA, a jest powiązany z UserForm, Arkuszem lub ThisWorkbook, konieczne będzie zadeklarowanie funkcji interfejsu API przy użyciu słowa kluczowego Private). Deklaracja funkcji API musi obejmować interpreter VBA o funkcji interfejsu, która zostanie użyta, bibliotece, w której się ona znajduje i jej argumentach. Po zadeklarowaniu funkcji można ją użyć w kodzie.

Katalog systemu Windows Kliknij, żeby (roz)winąć listing

Declare Function GetWindowsDirectoryA Lib "kernel32" _
(ByVal lpBuffer As String, ByVal nSize As Long) As Long

Function Windows_DIR() As String
  Dim Ścieżka_WIN As String * 255
  Ścieżka_WIN = Space(255)
  Windows_DIR = Left(Ścieżka_WIN, GetWindowsDirectoryA _
  (Ścieżka_WIN, Len(Ścieżka_WIN)))
End Function

Sub Pokaż_ścieżkę_WIN()
  Dim Ścieżka_WIN As String * 255
  Dim WIN_DIR As String

  Ścieżka_WIN = Space(255)
  WIN_DIR = Left(Ścieżka_WIN, GetWindowsDirectoryA _
  (Ścieżka_WIN, Len(Ścieżka_WIN)))

  MsgBox WIN_DIR, vbInformation, "Ścieżka katalogu systemu WINDOWS"
End Sub

Sub Pokaż_katalog_Funkcja()
  MsgBox "Komunikat jako wykonanie zadeklarowanej funkcji " & Chr(10) & _
  Windows_DIR, vbInformation, "Ścieżka katalogu systemu WINDOWS"
End Sub

Wykrywanie wciśnięcia przycisku Shift Kliknij, żeby (roz)winąć listing

Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Sub Przycisk_Click()
  Const VK_SHIFT As Integer = &H10
  If GetKeyState(VK_SHIFT) < 0 Then
  MsgBox "Klawisz Shift został wciśnięty"
  Else
  MsgBox "Klawisz Shift nie został wciśnięty"
  End If
End Sub

Aktualna rozdzielczość karty graficznejKliknij, żeby (roz)winąć listing

Sub Pokaż_rozdzielczość()
vidWidth = GetSystemMetrics(SM_CXSCREEN)
vidHeight = GetSystemMetrics(SM_CYSCREEN)

MsgBox "Aktualna rozdzielczość karty graficznej: " & Chr(10) & _
vidWidth & " X " & vidHeight
End Sub

Otwieranie strony www w domyślnej przeglądarceKliknij, żeby (roz)winąć listing

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Sub Otwórz_stronę()
Dim URL As String
URL = "http://www.programywexcelu.boo.pl"
Call ShellExecute(0, ybNullString, URL, _
vbNullString, vbNullString, vbNormalFocus)
End Sub

Zmiana drukarki domyślnej /wejście do panelu sterowania/Kliknij, żeby (roz)winąć listing

Sub StartDrukarki()
Dim Arg As String
Dim TaskID
Arg = "rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL PrintersFolder"
On Error Resume Next
TaskID = Shell(Arg)
If Err <> 0 Then
MsgBox ("Nie można uruchomić aplikacji.")
End If
End Sub

Odtwarzanie dźwięku przy zmianie komórki Excela Kliknij, żeby (roz)winąć listing

Odtwarzanie dźwięku wprowadzono jako funkcję użytkownika Alarm(Komórka, warunek). W przykładzie widocznym na zrzucie ekranu funkcja monitoruje wartość komórki "B3" sumującej komórki "A2" i "A3". Jeżeli warunek jest spełniony to odtworzony zostanie plik audio. Położenie tego pliku zadeklarowano w tym samym katalogu co plik wywołujący. Załącznikiem punktu jest archiwum z dwoma plikami do ściągnięcia w dziale pliki.

Listing - Module 1
Private Declare Function DajGłos Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long

Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000

Sub Odtwarzanie_WAV()
WAVFile = "tada.wav"
WAVFile = ThisWorkbook.Path & "\" & WAVFile
Call DajGłos(WAVFile, 0&, SND_ASYNC Or SND_FILENAME)
End Sub

Listing - Module 2
Private Declare Function DajGłos Lib "winmm.dll" _
Alias "PlaySoundA" (ByVal lpszName As String, _
ByVal hModule As Long, ByVal dwFlags As Long) As Long


W punkcie przedstawiane są gotowe procedury służące do wywołania funkcji Windows API tzn. elementów sterownia aplikacją niedostępnym z poziomu języka VBA (np. określenie aktualnej rozdzielczości karty graficznej, dodawanie dźwięków do aplikacji itp.) Punt ten będzie stopniowo uzupełniany.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Sterowanie Wordem z poziomu Excela KLIKNIJ by (roz)winąć

W Excelu można napisać makro zarządzające pracą innej aplikacji - w tym wypadku jest to Word. Jest to tzw. łączenie i osadzanie obiektów (ang. Object Linking and Embedding - OLE) lub automatyzacja. Technika ta powoduje, że użytkownik Excela może pracować z aplikacją Worda nie zdając sobie z tego sprawy. Przed wykonaniem działań związanych z aplikacją zewnętrzną należy utworzyć egzemplarz obiektu. Można to zrobić tzw. wiązaniem (wczesnym lub późnym). Aby wykorzystać wczesne wiązanie należy utworzyć odwołanie do biblioteki obiektów poprzez wybranie polecenia Tools/References w edytorze Visual Basic. W przypadku wiązania późnego typ obiektu jest znany dopiero w trakcie wykonywania programu. Wykorzystuje się polecenie CreateObject (tworzenie obiektu) lub GetObject (dostęp do zapisanego egzemplarza projektu).

Tworzonym obiektem jest szablon wydruku karty urlopowej przesłany przez jednego z użytkowników strony. Tworzenie makra rozpocząłem od zarejestrowania w Wordzie makra umożliwiającego tworzenie tego typu druku. Ze względu na znaczny stopień skomplikowania rejestracja makra następowała etapami. W treści dokumentu występują też elementy graficzne. Z niejasnych dla mnie przyczyn elementów tych nie można zarejestrować w Wordzie. Zastosowałem osadzenie ich w skoroszycie Excela i kopiowanie do Worda. Problemem okazał się fakt, że po skopiowaniu elementów graficznych z Excela do obiektu Worda, likwidacja obiektu powodowała wyświetlenie komunikatu o materiale w schowku Windowsa. Czyszczenie schowka osiągnąłem bardzo prostą metodą przez skopiowanie pustej komórki.
Makro było kopiowane do Excela z zastosowaniem konstrukcji With _ End With. Na początku każdej instrukcji wprowadzona została kropka. Inna zmiana na linii Word-Excel to sposób podawania wymiarów np. wcięć akapitów - różnice te zaznaczyłem w listingu. W książce J. Walkenbach "Excel 2003. Programowanie VBA", z której korzystałem przy tworzeniu zamówionej aplikacji, której elementy omawiam, przedstawiony jest dość obszernie materiał teoretyczny wyjaśniający zarządzanie Wordem spod Excela oraz ćwiczenie polegające na wydruku trzech notatek dotyczących sprzedaży w poszczególnych regionach firmy handlowej z wykorzystaniem danych o sprzedaży z arkusza Excela. Sam druk był bardzo prosty i z tego względu zdecydowałem się wprowadzić zapis bardziej rozbudowany. W książce omówiony jest też sposób na tworzenie wykresu Excela z poziomu Worda. Pełna stworzona aplikacja ma umożliwiać na podstawie wybranych w formularzu użytkownika parametrów (z listy rozwijanej imienia i nazwiska kierowcy, z okien tekstowych dat dokumentu, z przycisków opcji przyczyny wolnego) wydruk spersonalizowanej karty urlopu z podaniem daty ostatniego wydruku (wyświetlenie ostrzeżenia) co ma pozwolić uniknąć drukowania zdublowanych kart przy obsłudze aplikacji przez różnych pracowników. Poniżej przedstawiam listing makra zarejestrowanego w Wordzie i makra importowanego do Excela.
Plik z makrem omawianym w tym punkcie dostępny jest do ściągnięcia w dziale pliki.

Tworzenie dokumentu tekstowego - makro Word Kliknij, żeby (roz)winąć listing

Sub Urlop_2()
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With

With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(0.87)
.BottomMargin = CentimetersToPoints(0.88)
.LeftMargin = CentimetersToPoints(1.6)
.RightMargin = CentimetersToPoints(1.6)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.25)
.FooterDistance = CentimetersToPoints(1.25)
.PageWidth = CentimetersToPoints(21)
.PageHeight = CentimetersToPoints(29.7)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With

Selection.Font.Size = 9
Selection.Font.Bold = wdToggle
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.TypeText Text:= _
"ŚWIADECTWO DZIAŁALNOŚCI NA PODSTAWIE ROZPORZĄDZENIA (WE) NR 561/2006 LUB UMOWY EUROPEJSKIEJ"
Selection.TypeParagraph
Selection.TypeText Text:= _
"DOTYCZĄCEJ PRACY ZAŁÓG POJAZDÓW WYKONUJĄCYCH MIĘDZYNARODOWE PRZEWOZY DROGOWE (AETR)"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:= _
"ATTESTATION OF ACTIVITIES UNDER REGULATION (EC) 561/2006 OR THE EUROPEAN AGREEMENT"
Selection.TypeParagraph
Selection.TypeText Text:= _
"CONCERTNING THE WORK OF CREWS OF VEHICLES ENGAGED IN INTERNATIONAL ROAD TRANSPORT (AETR)"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeText Text:= _
"BESCHEINIUNG VON TATIGKEITEN GEMASS DER (EG) NR 561/2006 ODER GEMASS DEM EUROPAISCHEN"
Selection.TypeParagraph
Selection.TypeText Text:= _
"UBERENKOMMEN UBER DIE ARBEIT DES IM INTERNATIONALEN STRASSENVEREHR BESCHAFTIGTEN"
Selection.TypeParagraph
Selection.TypeText Text:="FAHRPERSONALS (AETR)"
Selection.TypeParagraph
Selection.TypeParagraph

Selection.Font.Bold = wdToggle
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0.63)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpace1pt5
.Alignment = wdAlignParagraphCenter
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(-0.63)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With

Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="1."
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
" Nazwa Przedsiębiorstwa / Name of the undertaking / Name des Untemehmens: "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="XXXX"
Selection.TypeParagraph
Selection.TypeText Text:="2. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"Ulica i nr, kod pocztowy, miejscowość, państwo / Street address, Postal code City, Country / Strasse, Haus nr, Postleitzahl, Ort, Land: "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="XXXX"
Selection.TypeParagraph
Selection.TypeText Text:="3. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"Numer telefonu (w tym międzynarodowy numer kierunkowy) / Telephone number (including international prefix) / Telefon Nr. (mit internationaler Vorwahl): "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="XXXX"
Selection.TypeParagraph
Selection.TypeText Text:="4. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"Numer faxu (w tym międzynarodowy numer kierunkowy) / Fax number (including international prefix) / Fax nr. (mir internationaler Vorwahl): "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="XXXX"
Selection.TypeParagraph
Selection.TypeText Text:="5. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"Adres e-mail / E-mail address / E-mail-Adresse: "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="XXXX"
Selection.TypeParagraph
Selection.Font.Bold = wdToggle

With Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = CentimetersToPoints(-0.31)
End With

Selection.TypeText Text:= _
"Ja niżej podpisany / I, the undersigned / Ich, der / die Unterzelchnete"
Selection.TypeParagraph

With Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = CentimetersToPoints(-0.63)
End With

Selection.Font.Bold = wdToggle
Selection.TypeText Text:="6. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Imię i Nazwisko / Name / Name: "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:=" XXXX"
Selection.TypeParagraph
Selection.TypeText Text:="7. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"Stanowisko w przedsiębiorstwie / Position In the undertaking / Position im Untermehmen: "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="XXXX"
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="8. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Imię i Nazwisko / Name / Name: "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="XXXX"
Selection.TypeParagraph
Selection.TypeText Text:="9. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Data urodzenia / Date of birth / Gebursdatum: "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="XXXX"
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="10. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"Numer prawa jazdy lub dowodu osobistego lub paszportu / Driving license number of identity card number or Passport number / Nummer des Fuhrerscheins, des Personalausweises oder des Reisepasses: "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="XXXX"
Selection.TypeParagraph

With Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = CentimetersToPoints(1.28)
End With

Selection.Font.Bold = wdToggle
Selection.TypeText Text:="w okresie - for the period - im Zeitraum"
Selection.TypeParagraph

With Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = CentimetersToPoints(-0.63)
End With

Selection.Font.Bold = wdToggle
Selection.TypeText Text:="11. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"od (godzina - dzień - miesiąc - rok) / from (time - day - month - year) / von (Uhrzeit - Tag - Monat - Jahr):"
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
" .............................YYYYY...................."
Selection.TypeParagraph
Selection.TypeText Text:="12. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"do (godzina - dzień - miesiąc - rok) / to (time - day - month - year) / bis (Uhrzeit - Tag - Monat - Jahr):"
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:=" .............................YYYYY.........................."
Selection.TypeParagraph
Selection.TypeParagraph

Selection.TypeText Text:=vbTab & vbTab
Selection.Font.Bold = wdToggle
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Font.Size = 8
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Przebywał na zwolnieniu chorobowym" & vbTab & _
vbTab & vbTab & vbTab & vbTab & "prowadził pojazd wyłączony z zakresu"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & "was on sick leave" & vbTab & _
vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
"stosowania rozporządzenia (WE)"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & "im Krankheitsurlaub befand" & _
vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & "nr 561/2006 lub AETR"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "drove a vehicle exempted from the scope"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "of Regulation (EC) No 561/2006 or AETR"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "ein vom Anwendungsbereich der"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "Verurdnung (EG) Nr.561/2006 oder des"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "AETR ausgenominenes Fahrzeug"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "Gelenkt hat"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & _
"Przebywał na urlopie wypoczynkowym"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & "was on annual leave"
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & vbTab & "im Eraiungsurlaub befand"
Selection.TypeParagraph
Selection.Font.Size = 9
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="16. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"W imieniu przedsiębiorstwa (miejscowość-data-podpis) / For the undertaking (place, date, signature) / "
Selection.TypeParagraph

With Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = CentimetersToPoints(0.01)
End With

Selection.TypeText Text:= _
"Fur das Unternehrmen (Ort, Datum, Unterschrift):"
Selection.TypeParagraph

With Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = CentimetersToPoints(-0.63)
End With

Selection.TypeText Text:=vbTab & vbTab & vbTab
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"XXX ; ZZZZ ................................................................................"
Selection.TypeParagraph
Selection.TypeText Text:="17. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"Ja, jako kierowca, potwierdzam, że w wyżej wymienionym okresie nie prowadziłem pojazdu wchodzącego w zakres stosowania (WE) nr 561/2006 lub AETR / I, the driver, confrm that I have not been driving a vehicle falling under the scope of Regulation (EC) No 561/2006 or AETR during the period mentioned above / Ich, der Fahrer - die Fahrerin bestutige dass ich im vorstehend genannten Zeitruum keinunterden Anwendungsbereich der Voronung (EG) Nr. 561/2006 oder des AETR fallendes fahrzeng gelenkt habe. "
Selection.TypeParagraph
Selection.TypeText Text:=vbTab & _
".................................................................................................."
Selection.TypeParagraph
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="18. "
Selection.Font.Bold = wdToggle
Selection.TypeText Text:= _
"Miejscowość, data, Podpis kierowcy - Place date Signature of the driver - Ort Datum Unterschrife des Fahrers / der Fahrerin."
Selection.TypeParagraph
Selection.TypeText Text:=vbTab
Selection.Font.Bold = wdToggle
Selection.TypeText Text:=vbTab & _
"XXXXX;ZZZZZZ ......................................................................................"
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=31
Selection.TypeParagraph
End Sub


Tworzenie dokumentu tekstowego - makro Excel Kliknij, żeby (roz)winąć listing

Sub Drukuj_urlop()

'Procedura tworzenia notatki w Wordzie i zapisania jej do pliku
Dim WordApplication As Object
Dim Nazwa_pliku As String

'Uruchomienie Worda i utworzenie obiektu (późne wiązanie)
Set WordApplication = CreateObject("Word.Application")
Nazwa_pliku = ThisWorkbook.Path & "\" & "Próba_urlopu" & ".doc"

'Wysłanie dokumentu do Worda
With WordApplication
.Documents.Add

'Ustawienia strony w Wordzie /wymiary nie w cm tylko w punktach)
With .ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = 24.75
.BottomMargin = 24.75
.LeftMargin = 45.3
.RightMargin = 45.3
.Gutter = 0
.HeaderDistance = 31.25
.FooterDistance = 31.25
.PageWidth = 595.3
.PageHeight = 842.01
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With

'Piszemy tekst - nagłówek w trzech językach
With .Selection
.Font.Size = 9
.Font.Bold = True
.ParagraphFormat.Alignment = 1
.TypeText Text:= _
"ŚWIADECTWO DZIAŁALNOŚCI NA PODSTAWIE ROZPORZĄDZENIA (WE) NR 561/2006 LUB UMOWY EUROPEJSKIEJ"
.TypeParagraph
.TypeText Text:= _
"DOTYCZĄCEJ PRACY ZAŁÓG POJAZDÓW WYKONUJĄCYCH MIĘDZYNARODOWE PRZEWOZY DROGOWE (AETR)"
.TypeParagraph
.TypeParagraph
.TypeText Text:= _
"ATTESTATION OF ACTIVITIES UNDER REGULATION (EC) 561/2006 OR THE EUROPEAN AGREEMENT"
.TypeParagraph
.TypeText Text:= _
"CONCERTNING THE WORK OF CREWS OF VEHICLES ENGAGED IN INTERNATIONAL ROAD TRANSPORT (AETR)"
.TypeParagraph
.TypeParagraph
.TypeText Text:= _
"BESCHEINIUNG VON TATIGKEITEN GEMASS DER (EG) NR 561/2006 ODER GEMASS DEM EUROPAISCHEN"
.TypeParagraph
.TypeText Text:= _
"UBERENKOMMEN UBER DIE ARBEIT DES IM INTERNATIONALEN STRASSENVEREHR BESCHAFTIGTEN"
.TypeParagraph
.TypeText Text:="FAHRPERSONALS (AETR)"
.TypeParagraph
.TypeParagraph
.Font.Bold = False
End With

'Ustawienia akapitu do fragmentu karty z listą punktowaną
With .Selection.ParagraphFormat
.LeftIndent = 17 'CentimetersToPoints(0.63)
.RightIndent = 0 'CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = 1.49 'półtora wiersza "wdLineSpace1pt5" - przyjmuje tylko punkty zaokrąglane do 0,1
.Alignment = wdAlignParagraphCenter
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = -17 'CentimetersToPoints(-0.63)
'.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
'.ParagraphFormat
.Alignment = 3 'wdAlignParagraphJustify
End With

'Pisanie treści listy punktowanej od 1 do 12
With .Selection
.Font.Bold = True
.TypeText Text:="1."
.Font.Bold = False
.TypeText Text:= _
" Nazwa Przedsiębiorstwa / Name of the undertaking / Name des Untemehmens: "
.Font.Bold = True
.TypeText Text:="XXXX"
.TypeParagraph
.TypeText Text:="2. "
.Font.Bold = False
.TypeText Text:= _
"Ulica i nr, kod pocztowy, miejscowość, państwo / Street address, Postal code City, Country / Strasse, Haus nr, Postleitzahl, Ort, Land: "
.Font.Bold = True
.TypeText Text:="XXXX"
.TypeParagraph
.TypeText Text:="3. "
.Font.Bold = False
.TypeText Text:= _
"Numer telefonu (w tym międzynarodowy numer kierunkowy) / Telephone number (including international prefix) / Telefon Nr. (mit internationaler Vorwahl): "
.Font.Bold = True
.TypeText Text:="XXXX"
.TypeParagraph
.TypeText Text:="4. "
.Font.Bold = False
.TypeText Text:= _
"Numer faxu (w tym międzynarodowy numer kierunkowy) / Fax number (including international prefix) / Fax nr. (mir internationaler Vorwahl): "
.Font.Bold = True
.TypeText Text:="XXXX"
.TypeParagraph
.TypeText Text:="5. "
.Font.Bold = False
.TypeText Text:= _
"Adres e-mail / E-mail address / E-mail-Adresse: "
.Font.Bold = True
.TypeText Text:="XXXX"
.TypeParagraph
.Font.Bold = False

With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = -7 'CentimetersToPoints(-0.31)
End With

.TypeText Text:="Ja niżej podpisany / I, the undersigned / Ich, der / die Unterzelchnete"
.TypeParagraph

With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = -16 'CentimetersToPoints(-0.63)
End With

.Font.Bold = True
.TypeText Text:="6. "
.Font.Bold = False
.TypeText Text:="Imię i Nazwisko / Name / Name: "
.Font.Bold = True
.TypeText Text:=" XXXX"
.TypeParagraph
.TypeText Text:="7. "
.Font.Bold = False
.TypeText Text:= _
"Stanowisko w przedsiębiorstwie / Position In the undertaking / Position im Untermehmen: "
.Font.Bold = True
.TypeText Text:="XXXX"
.TypeParagraph

With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = -7 'CentimetersToPoints(-0.31)
End With

.Font.Bold = False
.TypeText Text:= _
"oświadczam, że kierowca / declare that the driver / erklare, dass sich der Fahrer/die Fahrerin:"
.TypeParagraph

With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = -16 'CentimetersToPoints(-0.63)
End With

.Font.Bold = True
.TypeText Text:="8. "
.Font.Bold = False
.TypeText Text:="Imię i Nazwisko / Name / Name: "
.Font.Bold = True
.TypeText Text:="XXXX"
.TypeParagraph
.TypeText Text:="9. "
.Font.Bold = False
.TypeText Text:="Data urodzenia / Date of birth / Gebursdatum: "
.Font.Bold = True
.TypeText Text:="XXXX"
.TypeParagraph
.TypeText Text:="10. "
.Font.Bold = False
.TypeText Text:= _
"Numer prawa jazdy lub dowodu osobistego lub paszportu / Driving license number of identity card number or Passport number / Nummer des Fuhrerscheins, des Personalausweises oder des Reisepasses: "
.Font.Bold = True
.TypeText Text:="XXXX"
.TypeParagraph

With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = 32 'CentimetersToPoints(1.28)
End With

.Font.Bold = False
.TypeText Text:="w okresie - for the period - im Zeitraum"
.TypeParagraph

With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = -16 'CentimetersToPoints(-0.63)
End With

.Font.Bold = True
.TypeText Text:="11. "
.Font.Bold = False
.TypeText Text:= _
"od (godzina - dzień - miesiąc - rok) / from (time - day - month - year) / von (Uhrzeit - Tag - Monat - Jahr):"
.TypeParagraph
.Font.Bold = True
.TypeText Text:= _
" .............................YYYYY...................."
.TypeParagraph
.TypeText Text:="12. "
.Font.Bold = False
.TypeText Text:= _
"do (godzina - dzień - miesiąc - rok) / to (time - day - month - year) / bis (Uhrzeit - Tag - Monat - Jahr):"
.TypeParagraph
.Font.Bold = True
.TypeText Text:=" .............................YYYYY.........................."
.TypeParagraph
.TypeParagraph
End With

'Akapit związany z okienkami wyboru
With .Selection
.TypeText Text:=vbTab & vbTab
.Font.Bold = False
.Font.Size = 8
.TypeText Text:="Przebywał na zwolnieniu chorobowym" & vbTab & _
vbTab & vbTab & vbTab & vbTab & "prowadził pojazd wyłączony z zakresu"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & "was on sick leave" & vbTab & _
vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
"stosowania rozporządzenia (WE)"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & "im Krankheitsurlaub befand" & _
vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & "nr 561/2006 lub AETR"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "drove a vehicle exempted from the scope"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "of Regulation (EC) No 561/2006 or AETR"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "ein vom Anwendungsbereich der"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "Verurdnung (EG) Nr.561/2006 oder des"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "AETR ausgenominenes Fahrzeug"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & _
vbTab & vbTab & vbTab & vbTab & "Gelenkt hat"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & _
"Przebywał na urlopie wypoczynkowym"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & "was on annual leave"
.TypeParagraph
.TypeText Text:=vbTab & vbTab & "im Eraiungsurlaub befand"
.TypeParagraph
.Font.Size = 9
.TypeParagraph
End With

'Akapit listy punktowanej od 16 do 18
With .Selection
.Font.Bold = True
.TypeText Text:="16. "
.Font.Bold = False
.TypeText Text:= _
"W imieniu przedsiębiorstwa (miejscowość-data-podpis) / For the undertaking (place, date, signature) / "
.TypeParagraph

With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = 0.25 'CentimetersToPoints(0.01)
End With

.TypeText Text:= _
"Fur das Unternehrmen (Ort, Datum, Unterschrift):"
.TypeParagraph

With .ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = -16 'CentimetersToPoints(-0.63)
End With

.TypeText Text:=vbTab & vbTab & vbTab
.Font.Bold = True
.TypeText Text:= _
"XXX ; ZZZZ ................................................................................"
.TypeParagraph
.TypeText Text:="17. "
.Font.Bold = False
.TypeText Text:= _
"Ja, jako kierowca, potwierdzam, że w wyżej wymienionym okresie nie prowadziłem pojazdu wchodzącego w zakres stosowania (WE) nr 561/2006 lub AETR / I, the driver, confrm that I have not been driving a vehicle falling under the scope of Regulation (EC) No 561/2006 or AETR during the period mentioned above / Ich, der Fahrer - die Fahrerin bestutige dass ich im vorstehend genannten Zeitruum keinunterden Anwendungsbereich der Voronung (EG) Nr. 561/2006 oder des AETR fallendes fahrzeng gelenkt habe. "
.TypeParagraph
.TypeText Text:=vbTab & _
".................................................................................................."
.TypeParagraph
.Font.Bold = True
.TypeText Text:="18. "
.Font.Bold = False
.TypeText Text:= _
"Miejscowość, data, Podpis kierowcy - Place date Signature of the driver - Ort Datum Unterschrife des Fahrers / der Fahrerin"
.TypeParagraph
.TypeText Text:=vbTab
.Font.Bold = True
.TypeText Text:=vbTab & _
"XXXXX; ZZZZZZ .........................................................................................................."
.TypeParagraph
End With

'Kopiowanie i wklejanie prostokątów - 2 z krzyżykiem
Arkusz3.Shapes("Rectangle 2").Copy

With .Selection
.Paste
.Cut
.ShapeRange.Delete
.Paste
.ShapeRange.IncrementLeft -233.1
.ShapeRange.IncrementTop 310.9
.Collapse
End With

With .Selection
.Paste
.Cut
.Paste
.ShapeRange.IncrementLeft 48.9
.ShapeRange.IncrementTop 310.9
.Collapse
End With

With .Selection
.Paste
.Cut
.Paste
.ShapeRange.IncrementLeft -233.1
.ShapeRange.IncrementTop 436.9
.Collapse
End With

.ActiveDocument.SaveAs Filename:=Nazwa_pliku
.ActiveDocument.PrintOut

'Skopiowanie pustej komórki czyści schowek
Arkusz1.Range("A1").Copy

'Zniszczenie obiektu
WordApplication.Quit
Set WordApplication = Nothing

End With
End Sub

W punkcie przedstawiono sposób na wykonanie wydruku Worda z zapisem pliku z poziomu Excela za pomocą tzw. późnego wiązania. Jest to wydruk karty urlopowej kierowców wykonany na podstawie prośby jednego z użytkowników strony. Wykorzystano ten szablon ze względu na znaczny stopień skomplikowania wydruku. Więcej na temat zarządzania Wordem spod Excela można znaleźć w książce J. Walkenbach "Excel 2003. Programowanie VBA". Metoda ta oferuje duże możliwości przy wydruku jednakowych treści informacji z wykorzystaniem danych liczbowych z tabel Excela np. informacja do pracowników o wysokości przyznanej premii itp. Plik z makrem prezentowanym w niniejszym punkcie jest do ściągnięcia w dziale pliki.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Monitorowanie wielokrotnych wpisów w kolumnie Excela KLIKNIJ by (roz)winąć

Punkt powstał na podstawie zapytania jednego z użytkowników strony o sposób eliminowania wielokrotnych wpisów w danej kolumnie Excela. Wykorzystałem fragment skoroszytu do przyjmowania zgłoszeń awarii stosowany w mojej pracy tzw. "REJESTR KONSERWATORÓW". Jednym z arkuszy tego pliku jest arkusz "OKNA" służący do umawiania terminów wizyty komisji okiennej. Wizyta komisji na każdym lokalu może odbyć się tylko raz w roku, więc wygodnie jest aby podczas wpisywania aplikacja automatycznie sprawdzała ewentualne poprzednie wpisy. Ze względu na fakt, że umówiona komisja mogła nie dojść do skutku (brak użytkownika lokalu, zdarzenia losowe) aplikacja w oknie komunikatu podaje zestawienie dotychczasowych wpisów zostawiając użytkownikowi programu decyzję, czy wpisać kolejny termin. W kolumnie C wpisywane są adresy (dowolny ciąg znaków), a w kolumnie D ewentualne uwagi. Układ tabeli na załączonym screenie:

Realizacja makra polega na odpowiednim oprogramowaniu zdarzeń dla arkusza.
Podstawowym zdarzeniem jest Worksheet_Change tzn. zmiana/przeliczenie dowolnej komórki w arkuszu. Dla bezpieczeństwa przy aktywacji arkusza (Worksheet_Activate) następuje ustawienie formatowań kolumn C i D na tekstowe (wpisywane są adresy w formie cyfrowej więc przynajmniej niektóre z nich mogłyby zostać potraktowane jako liczby).
W pełnym makrze obsługi zdarzenia zmiany arkusza ustawiana jest zmienna "Zakres" na obszar kolumny C. Zmienna ta zostanie wykorzystania w konstrukcji warunkowej If Not _ End If. W pętli For Each _ Next następuje przeszukanie wszystkich komórek w zakresie i zmiana zmiennej "Licznik". Jeżeli adres był wpisywany pierwszy raz to wartość tej zmiennej wynosi 1. Zmienna "Szukana_wartość" ustawiona jest na jedną komórkę powyżej komórki aktywnej ze względu na fakt, że zdarzenia wywołuje wciśnięcie w danej komórce przycisku "Enter", a ten powoduje również aktywowanie niższej komórki.
W warunku If Not _ End If następuje sprawdzenie wartości zmiennej "Licznik" i wywołanie procedury z modułu zewnętrznego. Procedura zewnętrzna "Sprawdzaj_duble" ma za zadnie przeszukać dany zakres i podać adresy i przynależne do komórek daty z kolumny B, jeżeli występuje zwielokrotniona wartość wpisu. Oczywiście polecenie Call można było zastąpić poleceniem czyszczenia komórki ze zdublowaną wartością. Warunek uzupełniający dotyczący zmiennej "Szukana_wartość" ma zapobiegać sytuacji gdy wyczyszczenie danej komórki (wprowadzenie pustego ciągu tekstowego) uruchamia procedurę szukania wpisów zdublowanych.
W przypadku wpisów wielokrotnych wynikiem działania procedury jest komunikat jak na zrzucie ekranu:

Plik z makrem omawianym w tym punkcie dostępny jest do ściągnięcia w dziale pliki.

Listing zdarzeń dla arkusza Kliknij, żeby (roz)winąć listing

Private Sub Worksheet_Activate()
Arkusz1.Range("C4:C1026").NumberFormat = "@"
Arkusz1.Range("D4:D1026").NumberFormat = "@"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Zakres As Range
Set Zakres = Range("C4:C1026")

Dim Przeszukiwany_Zakres As Range
Dim Komórka As Range
Dim Szukana_wartość As Variant
Dim Licznik As Integer

Set Przeszukiwany_Zakres = Arkusz1.Range("C4:C1026")
Szukana_wartość = ActiveCell.Offset(-1, 0).Value
Licznik = 0

For Each Komórka In Przeszukiwany_Zakres
If Komórka.Value = Szukana_wartość Then
Licznik = Licznik + 1
End If
Next Komórka

If Not Intersect(Target, Zakres) Is Nothing Then
If Licznik > 1 And Szukana_wartość <> "" Then
Call Sprawdzaj_duble
End If
End If

End Sub

Listing procedury "Sprawdzaj duble" Kliknij, żeby (roz)winąć listing

Procedura "Szukaj_duble"

Sub Sprawdzaj_duble()

'Makro wywoływane zmianą zakresu arkusza OKNA
'sprawdza czy adresy dublują się z ewentualnym wyświetleniem komunikatu

Dim Przeszukiwany_Zakres As Range
Dim Komórka As Range
Dim Szukana_wartość As Variant
Dim Data As Date
Dim Komórka_Daty As Range
Dim Komunikat As String
Dim Uwaga As String

Set Przeszukiwany_Zakres = Arkusz1.Range("C4:C1026")
Szukana_wartość = ActiveCell.Offset(-1, 0).Value
Komunikat = "WPISANA WARTOŚĆ WYSTĘPUJE W NASTĘPUJĄCYCH POZYCJACH"

For Each Komórka In Przeszukiwany_Zakres
If Komórka.Value = Szukana_wartość Then
Set Komórka_Daty = Komórka.Offset(0, -1)
Do Until Komórka_Daty.Value <> ""
Set Komórka_Daty = Komórka_Daty.Offset(-1, 0)
Loop
Data = Komórka_Daty.Value

Uwaga = " bez uwag "
If Komórka.Offset(0, 1).Value <> "" Then
Uwaga = " z uwagą: " & Komórka.Offset(0, 1).Value
End If

Komunikat = Komunikat & Chr(10) & Chr(10) & Komórka.Value & " z dnia: " & Data & Uwaga & _
" /adres komórki: " & Komórka.Address & "/"
End If
Next Komórka

MsgBox Komunikat, _
vbInformation, _
"REJESTR KONSERWATORÓW"

End Sub

Punkt omawia moją propozycję realizacji arkusza, który podczas użytkowania monitoruje wpisy w kolumnie, a w przypadku wpisów wielokrotnych podejmuje określone działania. Opracowany został na podstawie zapytania jednego z użytkowników strony na przykładzie pliku roboczego wykorzystywanego w mojej pracy. W treści punktu podano pełne listingi procedur, a załącznikiem punktu jest plik "Duble_w_kolumnie" do ściągnięcia w dziale pliki.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Pierwsza wolna komórka w wierszu/kolumnie KLIKNIJ by (roz)winąć

Punkt powstał na podstawie częstych zapytań użytkowników strony o sposób znajdowanie pierwszej wolnej lub ostatniej zajętej komórki w wierszu lub kolumnie arkusza. Prosta, ale przydatna i często wykorzystywana procedura. Na początku stosowałem w takich wypadkach pętlę Do ... Until ... Loop. Poniżej przedstawiam sposób dużo bardziej elegancki.

Omówienie listingów - najpierw pierwsza wolna w kolumnie:
Zmienna Numer_kolumny pobierana jest od użytkownika. Instrukcja On Terror GoTo ma zapobiegać komunikatom o błędach przy wprowadzaniu błędnych danych.
Najważniejszy jest fragment podstawiający pod zmienną Ostatni_wiersz odpowiednią wartość. Obiekty typu Range mają właściwość End(kierunek). W tym przypadku kierunek to xlUp czyli do góry. Instrukcja Cells(Rows.Count, Numer_kolumny) określa ostatni wiersz w kolumnie o podanym numerze i podaje go dzięki właściwości Rows. W ten sposób znaleziona zostanie ostatnia zajęta komórka - by uzyskać pierwszą wolną do wartości dodajemy 1. W następnych wierszach wstawiamy ciąg tekstowy do tej komórki i w oknie komunikatu wyświetlamy adres komórki.

Omówienie listingów - teraz pierwsza wolna w wierszu:
Zmienna Numer_wiersza pobierana jest od użytkownika. Instrukcja On Terror GoTo ma zapobiegać komunikatom o błędach przy wprowadzaniu błędnych danych.
Najważniejszy jest fragment podstawiający pod zmienną Ostatnia_kolumna odpowiednią wartość. Obiekty typu Range mają właściwość End(kierunek). W tym przypadku kierunek to xlLeft. Instrukcja Cells(Numer_wiersza, Columns.Count) określa ostatnią kolumnę w wierszu o podanym numerze i podaje go dzięki właściwości Columns. W ten sposób znaleziona zostanie ostatnia zajęta komórka - by uzyskać pierwszą wolną do wartości dodajemy 1. W następnych wierszach wstawiamy ciąg tekstowy do tej komórki i w oknie komunikatu wyświetlamy adres komórki.

Plik z makrem omawianym w tym punkcie dostępny jest do ściągnięcia w dziale pliki.

Pierwsza wolna /ostatnia zajęta/ komórka w kolumnieKliknij, żeby (roz)winąć listing

Sub Pierwsza_pusta_komórka_w_kolumnie()

Dim Ostatni_wiersz As Long
Dim Pierwsza_wolna_komórka As Range
Dim Numer_kolumny As Long

On Error GoTo Koniec

Numer_kolumny = InputBox("Podaj numer kolumny (kolumna A - nr 1; kolumna B - numer 2 itd)", "Pierwsza wolna komórka")
Ostatni_wiersz = Cells(Rows.Count, Numer_kolumny).End(xlUp).Row + 1
Set Pierwsza_wolna_komórka = Cells(Ostatni_wiersz, Numer_kolumny)
Pierwsza_wolna_komórka.Value = "G_Koral"
MsgBox Prompt:=Pierwsza_wolna_komórka.Address, Title:="Pierwsza wolna komórka w kolumnie"

Exit Sub
Koniec:

End Sub


Pierwsza wolna /ostatnia zajęta/ komórka w wierszuKliknij, żeby (roz)winąć listing

Sub Pierwsza_pusta_komórka_w_wierszu()

Dim Ostatnia_kolumna As Long
Dim Pierwsza_wolna_komórka As Range
Dim Numer_wiersza As Long

On Error GoTo Koniec

Numer_wiersza = InputBox("Podaj numer wiersza", "Pierwsza wolna komórka")
Ostatnia_kolumna = Cells(Numer_wiersza, Columns.Count).End(xlToLeft).Column + 1
Set Pierwsza_wolna_komórka = Cells(Numer_wiersza, Ostatnia_kolumna)
Pierwsza_wolna_komórka.Value = "G_Koral"
MsgBox Prompt:=Pierwsza_wolna_komórka.Address, Title:="Pierwsza wolna komórka w wierszu"

Exit Sub
Koniec:

End Sub


Punkt omawia często poszukiwany temat: określanie ostatniej zajętej lub pierwszej pustej komórki w wierszu/kolumnie arkusza Excela. Pierwszą wolną komórkę można znaleźć na różne sposoby. Na początku stosowałe pętle Do Until Loop - zamiast takich stosunkowo skomplikowanych konstrukcji można zastosować jednolinijkową instrukcję VBA. W treści punktu podano listingi procedur, a załącznikiem punktu jest plik "pierwsza_wolna" do ściągnięcia w dziale pliki.

Spis artykułów Frazy Google Przykłady makr Do strony głównej

Krótkie zapytania dot. VBA w Excelu

W tym punkcie postaram się przedstawiać odpowiedzi na zapytania dot. VBA w Excelu, które nie wymagają dłuższego rozwinięcia (oczywiście przy założeniu, że udało mi się poprawnie zinterpretować zapytanie wprowadzone do wyszukiwarki ;)

ILOŚĆ MIEJSC PO PRZECINKU VBA KLIKNIJ by (roz)winąć

Arkusz kalkulacyjny Excel standardowo dokonuje obliczeń z dokładnością do kilkunastu miejsc po przecinku. Nawet jeżeli ustawimy wyświetlanie liczb z dokładnością do dwóch miejsc po przecinku to dotyczy to tylko wyświetlania, a nie dokonywania obliczeń. Aby trwale dla danego arkusza zmienić dokładność obliczeń to (dla Excela 2003) w menu 'Narzędzi', podmenu 'Opcje' i zakładce 'Przeliczanie' zaznaczamy opcję 'dokładność jak wyświetlono'. Arkusz kalkulacyjny poinformuje o trwałej utracie dokładności i zachowa zmiany dla tego arkusza (najczęściej z tego typu wymaganiami zetknąłem się w obliczeniach finansowych np. naliczenia opłat za lokal itp.). Okno opcji przedtawiono na załączonym zrzucie z ekranu.
Powyższe rozwiązanie jest dobre dla tabel Excela, ale niekoniecznie dla programowania VBA (chociaż teretycznie można dokonywać obliczeń w komórkach arkusza i dopiero z nich pobierać dane do procedury VBA). Obecnie dla uzyskania dokładności do dwóch miejsc po przecinku stosuję zapis:
- Liczba_A = CCur(Format(Liczba_B, "0.#0"))
gdzie:
- Liczba A to zmienna z dokładnością dwóch miejsc po przecinku,
- Liczba B to zmienna z inną dokładnością,
- CCur - zamiana liczby na format walutowy (w tym przykładzie zbędne - zamieściłem ten zapis tylko dla podkreślenia, że najczęściej taka sytuacja dotyczy obliczeń finansowych),
Pierwszy raz z tego typu problemem zetknąłem się dla programu WYKUP GRUNTÓW, wcześniej stosowałem różne dziwne manewry (do których teraz już się nie przyznam ;) Inna dokładność niż dwa miejsca po przecinku wymaga zmiany fragmentu "0.#0" - ale to już do własnych prób ;)
Nieco wiecej na ten temat w artykule:
Obliczenia wartości księgowych w Excelu. Dlaczego suma złotówek się nie zgadza? w dziale 'Programy od kuchni'

W punkcie przedstawiono możliwości zmiany domyślnej dokładności obliczeń dla Excela, a także formatowania obliczanych wartości liczbowych w kodzie VBA. Zagadnienia przydatne zwłaszcza przy obliczeniach wartości księgowych, gdzie dokładność obliczeń decyduje o przydatności danego pliku.

USTAWIENIE WŁAŚCIWOŚCI VISIBLE KLASY WORKSHEET KLIKNIJ by (roz)winąć

Właściwość Visible ustawiałem w swoich programach dla arkuszy roboczych pliku. W edytorze VBA w Excelu w oknie 'Properties' (menu 'View', klawisz F4 itp.) dostępne są trzy wartości właściwości Visible:
- xlSheetVisible - arkusz widoczny,
- xlSheetHidden - arkusz ukryty, ale można go uwidocznić bez edytowania kodu (w menu Excela 2003 - 'Format/Arkusz/Odkryj'),
- xlSheetVeryHidden = arkusz ukryty, ale w liście arkuszy do odkrycia bedzie również niewidoczny (można go zobaczyć używając odpowiednich komend VBA z poziomu innego pliku),
Do właściwości Visible można również odwołać się w kodzie makra przez polecenia:
Nazwa_arkusza.Visible = xlSheetVisible,
gdzie Nazwa_arkusza odnosi się do 'Name' (standardowo Arkusz1, Arkusz2, Arkusz3 itd.), a nie do 'Caption'.

Podobne tematy artykułów tej strony to np.
- Ukrywanie arkuszy roboczych programu - obsługa zdarzeń,
- Zabezpieczenie arkusza przed zmianą danych,

W punkcie przedstawiono możliwości programowego ustawienia widoczności arkuszy Excela za pomocą własności Visible. Wskazano podstawowe różnice między Hidden i VeryHidden. Funkcje bardzo często wykorzystywane w samodzielnych programach dla poprawienia wygody obsługi aplikacji.

KILKA PRZYCISKÓW OPCJI W JEDNYM FORMULARZU EXCELA KLIKNIJ by (roz)winąć

Przycisk opcji jest często spotykaną kontrolką. W Excelu jest ona dostępna zarówno jako kontrolka ActiveX, 'zwykła' jak również na poziomie formularzy VBA. Zaznaczenie jednej kontrolki (wartość logiczna True, kontrolka zaczerniona) powoduje jednoczesne 'wyzerowanie' pozostałych przycisków opcji danego obszaru (arkusza, formularza itp.) tzn. nadanie pozostałym OptionButton wartości logicznej False. Jeżeli chcemy mieć na formularzu kilka różnych zespołów opcji wzajemnie niezależnych odpowiednie przyciski należy zgrupować wewnątrz ramek 'Frame'. W ten sposób można uzyskać efekt, gdy użycie kontrolki wewnątrz ramki nie wpływa na pozostałe przyciski opcji umiejscowione poza ramką. Czasami bardziej przydatny może być jednak ToggleButton, dla którego można zdefiniować, że wartość logiczna jednej kontrolki ma określony wpływ na pozostałe kontrolki formularza.

Przycisk opcji jest kontrolką znaną z wielu programów Windowsa - zaznaczenie jednej opcji powoduje zmianę zaznaczenia wszystkich pozostałych. Co jednak zrobić gdy w jednym formularzu chcemy mieć dwie grupy przycisków opcji?

POBIERANIE DANYCH Z JEDNEGO USERFORMS DO DRUGIEGO USERFORMS KLIKNIJ by (roz)winąć

Krótka notatka na temat wymienionego zagadnienia musi uwzględniać opis niektórych zdarzeń dla UserForm. W swoich programach najczęściej w odniesieniu do formularzy użytkownika stosuję polecenia Show i Hide. Jeżeli formularz jeszcze nie został użyty w trakcie działania programu to metoda Show powoduje zdarzenie Initialize, jeżeli formularz był już załadowany do pamięci i nie został z niej usunięty (metoda Hide ukrywa formularz, ale nie usuwa go z pamięci) to metoda Show generuje zdarzenie Activate. Krótkie informacje na temat niektórych zdarzeń formularzy:
- Initialize - występuje przed wyświetleniem formularza, ale nie jest generowane jeżeli wyświetlany formularz był wcześniej ukryty,
- Activate - występuje po wyświetleniu formularza,
- QueryClose - występuje przed rozpoczęciem usuwania formularza z pamięci (zamknięcie formularza krzyżykiem w prawym, górnym rogu),
- Terminate - występuje po usunięciu formularza z pamięci,
Zastosowanie Show powoduje zdarzenia Initialize i Activate (w tej kolejności), zastosowanie Load generuje tylko zdarzenie Initialize. Instrukcja Unload generuje zdarzenia QueryClose i Terminate (w tej kolejności). Metoda Hide nie generuje żadnego z tych zdarzeń.
Jeżeli formularz został wyświetlony, a później ukryty to do wartości jego kontrolek można odwoływać się w pozostałych procedurach aplikacji przez podanie nazwy formularza, kontrolki i potem właściwości np. 'UserForm1.TextBox2.Value'. Jeżeli formularz został usunięty z pamięci to właściwości jego kontrolek przyjmują wartości domyślne (takie z jakimi formularz został 'narysowany' w edytorze VBA). W swoich programach stosowałem również zapisywanie wartości kontrolek formularza do komórek arkusza. Kolejny wywoływany formularz w obsłudze zdarzeń (np. Activate) pobierał wartości swoich kontrolek z komórek arkusza. Książka Walkenbacha prezentowana na tej stronie podaje również (str. 377), że wartości kontrolek można przed usunięciem formularza z pamięci zapisać w zmiennych publicznych (zadeklarowanych z użyciem słowa kluczowego Public).
Generalnie odpowiednie posługiwanie się zdarzeniami dla formularza pozwala uzyskać ciekawe efekty np. w programie BAZA TELEADRESOWA formularz 'Raport lokalu mieszkalnego' zawiera etykiety i okna tekstowe, których widoczność zabezpieczona hasłem uzależniona jest od zdarzeń Initialize i Activate - patrz prezentacja wideo działania programu.
Osobom zainteresowanym tematem formularzy polecam książki p. Snarskiej i p. Walkenbacha (w tej kolejności) prezentowane w dziale literatura.

W punkcie przedstawiono możliwości przekazywania wartości z jednego formularza do innych formularzy danej aplikacji. Pozwala to związać ze sobą poszczególne formularze danej aplikacji ułatwiając obsługę programu. W punkcie omówiono podstawoe zagadnienia związane ze zdarzeniami formularzy i różnice między nimi.

JAK SPRAWDZIĆ CZY ZAKRES ZAWIERA PUSTE KOMÓRKI VBA EXCEL KLIKNIJ by (roz)winąć

W wielu przypadkach dla realizacji wskazanego w pytaniu zadania wystarczy wykorzystać standardową funkcję Excela. W grupie funkcji 'Statystyczne' dostępna jest między innymi funkcja '=LICZ.PUSTE(Zakres)'.
Jak podaje ksiażka Walkenbacha (str. 810) jeżeli funkcja VBA będąca odpowiednikiem funkcji Excela nie jest dostępna to można użyć funkcji Excela bezpośrednio w kodzie VBA, poprzedzając wywołanie funkcji odwołaniem do obiektu WorksheetFunction. W przypadku liczenia pustych komórek w zakresie zaproponowałbym coś takiego:

Sub Licz_puste()
Dim A As Integer
Dim Zakres As Range
Set Zakres = Arkusz1.Range("A1:A5")
A = Application.WorksheetFunction.CountBlank(Zakres)
MsgBox (A)
End Sub

To małe makro spowoduje wyświetlenie w oknie komunikatu informacji o ilości pustych komórek w zakresie od A1 do A5 arkusza 1 danego skoroszytu (warto pamiętać, że nazwy funkcji Excela w edytorze VBA można uzyskać przez rejestrację makra).

W punkcie przedstawiono sposób rozwiązania podanego w tytule zagadnienia w oparciu o wykorzystanie w kodzie VBA standardowej funkcji Excela. Tego typu działanie jest często przydatne i pozwala na uniknięcie pisania kłopotliwych procedur.

CANCEL CHCĘ WYJŚĆ Z PROGRAMU INPUTBOX VBA KLIKNIJ by (roz)winąć

Funkcja InputBox służy do wprowadzania danych użytkownika (ten punkt dotyczy instrukcji InputBox dla VBA, ta sama funkcja, ale dla Excela jest nieco inna w zastosowaniu - patrz książka Walkenbacha z działu Literatura VBA str. 349-350). Wprowadzane wartości traktowane są jako zmienne typu łańcuch (String), a użycie przycisku 'Cancel' powoduje wprowadzenie łańcucha zerowej długości. Proponowane makro ma przyjmować od użytkownika kolejne liczby (zabezpieczenie uwzględnia wprowadzenie litery) do czasu gdy zostanie wprowadzony łańcuch pusty (przycisk Cancel okna "InputBox"). Warunkiem wyjścia z pętli o nieznanej liczbie powtórzeń 'Do Loop Until' jest wartość zmiennej 'Zawartosc_okna'. Jeżeli zmienna ta jest różna od "" - czyli łańcucha pustego odpowiednie wartości są uzwględniane w wartościach innych zmiennych. Po wykonaniu makra wyniki obliczeń wyświetlane są w prostym oknie komunikatu. Funkcja 'CSng' jest konwersją zmiennej łańcuchowej do zmiennej typu Single. Oczywiście wprowadzanie zmiennych tekstowych np. kolejnych nazwisk jest łatwiejsze. Przykład makra:

Makro - wprowadzanie danych Kliknij, żeby (roz)winąć listing

Sub Wprowadz_dane()

Dim A As Single
Dim Zawartosc_okna As String
Dim Suma As Single
Dim Ilosc As Integer
Dim Srednia As Single
Dim Komunikat As Integer

Suma = 0
Ilosc = 0
Srednia = 0

On Error GoTo Błąd:

Do
Zawartosc_okna = InputBox("Podaj kolejną liczbę", "Wprowadzanie danych")
If Zawartosc_okna <> "" Then
A = CSng(Zawartosc_okna)
Suma = Suma + A
Ilosc = Ilosc + 1
End If
Loop Until Zawartosc_okna = ""

Srednia = Suma / Ilosc

Komunikat = MsgBox("Ilość liczb wprowadzonych: " & Ilosc & _
Chr(10) & "Suma wprowadzonych liczb: " & Suma & Chr(10) & _
"Średnia arytmetyczna: " & Srednia, vbInformation + vbOKOnly, "Wyniki")

Exit Sub
Błąd:
Komunikat = MsgBox("Można wprowadzać tylko liczby", vbInformation + vbOKOnly, "Obsługa błędu")

End Sub

Wprowadzanie danych za pomocą okna Input Box jest przydatną funkcją, ale niektórym użytkownikom sprawia problem odpowiednie uwzględnienie w kodzie VBA możliwości użycia przycisku Cancel lub ograniczenia rodzaju danych wprowadzanych w tym oknie. Jeden ze sposobów oprogramowania tego typu sytuacji przedstawiony jest w tym punkcie wraz z listingiem.

WYWOŁYWANIE MAKRA PRZY AKTYWACJI ARKUSZA KLIKNIJ by (roz)winąć

Omówienie tego pytania wymaga przedstawienia w skrócie zdarzeń dla arkusza. W edytorze VBA po zaznaczeniu arkusza, mamy dostęp do jego zdarzeń. Po kliknięciu każdego z typów zdarzeń możemy wprowadzić w nie dowolny kod źródłowy (również wywoływać makra z modułów). Najczęściej chyba spotykanymi w programowaniu są:
- Activate - uaktywnienie arkusza,
- Calculate - przeliczenie arkusza,
- Change - modyfikacja arkusza przez użytkownika lub zewnętrzne łącze,
- Deactivate - dezaktywacja dowolnego arkusza,
Inne zdarzenia odwołują się np. do podwójnego kliknięcia, kliknięcia prawym przyciskiem myszy, kliknięcia na hiperłącze w danym arkuszu, modyfikację zaznaczenia, próbę zapisania, próbę wydruku, uaktualnienie tabel przestawnych itd.
W jednym z programów umieściłem opcję modyfikacji menu i likwidacji dodatkowego menu w zdarzeniach aktywacji i dezaktywacji arkusza - efekt jest zadowalający. Odpowiednią obsługą zdarzeń można uzyskać uruchomienie makra np. przy wprowadzaniu wartości do arkusza itp. W prezentowanej na niniejszej stronie książce Walkenbacha cały rozdział 19 poświęcowny jest obsłudze zdarzeń - polecam wszystkim zainteresowanym.

Najczęstszym sposobem używania makr jest przypisanie ich do kontrolki. Uruchomienie makra automayczne przy zmianie arkusza wymaga podstawowej znajomości obsługi zdarzeń dla arkusza. Te zagadnienia zasygnalizowane są w tym punkcie.

OBLICZANIE UKŁADU RÓWNAŃ LINIOWYCH MET. GAUSSA-JORDANA KLIKNIJ by (roz)winąć

Temat ten powstał na podstawie prośby jednego z użytkowników strony o wstawienie do Excela skryptu realizującego obliczanie układu równań liniowych metodą Gaussa-Jordana (skrypt napisany w basicu). Po drobnych przeróbkach skrypt wstawiłem jako funkcję Excela. Jest ona zapisana w Module1 pliku będącego załącznikiem niniejszego punktu. Całość funkcji opatrzyłem komentarzami na poszczególnych etapach co mam nadzieję pomoże osobom zainteresowanym w analizie algorytmu. Nie przedstawiam tutaj wykładu na temat w/w metody ponieważ:
- zasoby internetu są pod tym względem bardzo bogate,
- wcześniej nie stosowałem tej metody, a tylko wprowadziłem zaproponowany przez użytkownika skrypt do Excela,
- nie sprawdzałem jak algorytm działa dla układów sprzecznych i nieoznaczonych,
Plik, w którym dostępna jest w/w funkcja dostępny jest w dziale pliki niniejszej witryny. Oprócz Module1 z zapisem funkcji zawiera on arkusz, w którym na trzech przykładach zastosowałem wprowadzony algorytm. Być może moja dłubanina dla kogoś jeszcze będzie przydatna.
Poniżej przedstawiam kod funkcji Gauss_Jordan:

Funkcja VBA Excel - Gauss_Jordan Kliknij, żeby (roz)winąć listing

Function Gauss_Jordan(Apass As Range, bpass As Range)
'funkcja Gauss_Jordan ma dwa parametry konieczne do jej
'skutecznego wywołania: Apass i bpass
'typ Range oznacza, że trzeba wskazać obszar komórek

'zmienna n pobiera ilość wierszy obszaru Apass
'tzn. ilość równań
n = Apass.Rows.Count

'deklaracja trzech zmiennych tablicowych z elementami w tablicach
'typu Double (zmiennoprzecionkowe podwójnej precyzji)
Dim A(), B(), x() As Double

'słowo kluczowe ReDim zmienia zakres tablic dostosowując je do
'ilości równań.
'Tablica A jest dwuwymiarowa, tablice B i x jednowymiarowe
ReDim A(1 To n, 1 To n)
ReDim B(1 To n)
ReDim x(1 To n)

'Pętla zagnieżdżona For - Next podstawia pod tablice A i B
'odpowiednie elementy parametrów funkcji Apass i bpass
For p = 1 To n Step 1
For q = 1 To n Step 1
A(p, q) = Apass(p, q)
Next q
B(p) = bpass(p)
Next p

'Pętla zagnieżdżona For - Next realizuje algorytm metody Gaussa-Jordana
For k = 1 To n Step 1

factor = A(k, k)
For j = k To n Step 1
A(k, j) = A(k, j) / factor
Next j
B(k) = B(k) / factor
For i = 1 To n Step 1
If (i <> k) Then
factor = A(i, k)
For j = k To n Step 1
A(i, j) = A(i, j) - factor * A(k, j)
Next j
B(i) = B(i) - factor * B(k)
End If
Next i
Next k

'Pętla For - Next podstawia pod elementy tablicy x odpowiednie elementy tablicy rozwiązań B
For p = 1 To n Step 1
x(p) = B(p)
'uwaga - funkcja msgbox w oknie komunikatu wyświetli przy każdym
'powtórzeniu pętli wartość x z tablicy tj. kolejno wszystkie rozwiązania
MsgBox (x(p))
' w razie uciążliwości można potraktować jako komentarz - wstawić apostrof
Next p

'Wynikiem fukcji jest liczba - w tym wypadku tylko pierwsza liczba z zakresu tablicy x
Gauss_Jordan = x

End Function

Punkt powstały na podstawie prośby jednego z użytkowników strony. Dla innych może być przydatne prześledzenie sposobu wstawienia i wykorzystania niestandardowej funkcji użytkownika w oparciu o istniejący kod.

BLOKOWANIE WPROWADZANIA LITER DO TEXTBOX KLIKNIJ by (roz)winąć

Z podobnym problemem spotkałem się przy okazji realizacji programu WINDYKACJA KORESPONDENCJA. Załącznikiem punktu jest mały plik, na przykładzie którego chciałbym omówić to zagadnienie. Założeniem moim w w/w programie było by użytkownik w oknie tekstowym z wartością salda mógł wprowadzić tylko dane liczbowe, przy czym znak kropki zastępowany byłby przez bardziej naturalny znak przecinka. Materiał teoretyczny wykorzystany w tym punkcie to polecenia testujące VBA, polecenia konwertujące VBA i zdarzenia dla kontrolek. W przykładzie po uruchomieniu przycisku pojawi się formularz. Dane liczbowe wprowadzane są w oknie tekstowym, przycisk 'Zapisz dane' wprowadza wartości do kolejnych komórek kolumny poczynając od 'B7', a przycisk 'Następny' zeruje wartość okna tekstowego i ustawia focus na tej kontrolce. Idea jest taka, że przy opuszczaniu okna tekstowego program dla zdarzenia 'TextBox.Exit' sprawdzi czy wartość okna da się konwertować na liczbę (polecenie IsNumeric), jeżeli nie to zablokuje przyciski uniemożliwiając zapis danych do czasu ich poprawienia. Przy zapisie nastąpi konwersja wprowadzonej wartości do typu Double i zapis w pierwszej wolnej komórce zakresu. Nie jest to oczywiście jedyny sposób - na końcu punktu przedstawiam polecenia 'VarType' i 'TypeName', które dają większe możliwości sprawdzenia typów zmiennej.

Niektóre polecenia sprawdzające VBA:
- IsNumeric(wyrażenie) - zwraca wartość True lub False w zależności od tego czy wyrażenie da się konwertować do liczby,
- IsDate(wyrażenie) - zwraca wartość True lub False w zależności od tego czy wyrażenie da się konwertować do typu Data,
- IsEmpty(wyrażenie) - zwraca wartość True lub False w zalęzności od tego czy badana zmienna została zainicjowana,
- Isnull(wyrażenie) - jak wyżej ale w zależności od tego czy wyrażenie zawiera poprawne dane czy wartość Null,

Niektóre funkcje konwertujące VBA:
- CInt(wyrażenie) - zamienia wartość wyrażenia w postaci łańcucha na liczbę typu Integer (część ułamkowa zostaje zaokrąglona w dół),
- CLng(wyrażenie) - jak wyżej, ale na typ Long,
- CSng(wyrażenie) - jak wyżej, ale na typ Single,
- CDbl(wyrażenie) - jak wyżej, ale na typ Double,
- CCur(wyrażenie) - jak wyżej, ale na typ Currency,
- CDate(wyrażenie) - jak wyżej, ale na typ Date,

Dla kontrolki TextBox można użyć w omawianym wypadku zdarzenia TextBox_Exit - przy próbie opuszczenia okna program sprawdzi możliwość zamiany zawartości na typ Double. Wadą rozwiązania jest fakt, że próba zamknięcia formularza traktowana jest jako opuszczenie okna przy czym brak zawartości TextBox traktowany jest jako wartość False wyrażenia IsNumeric.
Załączony w dziale pliki niniejszej witryny przykład można wykorzystać jeszcze jako sposób dostosowania zachowania UserForm do wykonywanego działania (polecenia SetFocus, Enabled) - obsługa tylko z klawiatury numerycznej oraz przykład obsługi zdarzeń dla kontrolek.
Poniżej przedstawiam kod formularza.
W wielu zastosowaniach bardziej zgrabną metodą kontroli typu wartości wprowadzanej do TextBox będzie sprawdzenie typu zmiennej przy opuszczaniu okna tekstowego. Możliwe są funkcje 'VarType' i 'TypeName'.

Funkcja VarType(nazwa_zmiennej) zwraca wartość typu Integer, określającą typ badanej zmiennej:
- wartość 0 - Empty, niezainicjowana,
- wartość 1 - Null, brak poprawnych danych,
- wartość 2 - Integer,
- wartość 3 - Long,
- wartość 4 - Single,
- wartość 5 - Double,
- wartość 6 - Currency,
- wartość 7 - Date,
- wartość 8 - String,
- wartość 9 - Object,
- wartość 10 - Error,
- wartość 11 - Boolean,
- wartość 12 - tablica Variant,

Funkcja TypeName(nazwa_zmiennej) zwraca wartość typu String, zawierającą informacje o zmiennej:
- zwrócony łańcuch: 'Byte' - wartość typu Byte (naturalna),
- zwrócony łańcuch: 'Integer' - wartość typu Integer (całkowita),
- zwrócony łańcuch: 'Long' - wartość typu Long (całkowita),
- zwrócony łańcuch: 'Single' - wartość typu Single (zmiennoprzecinkowa),
- zwrócony łańcuch: 'Double' - wartość typu Double (zmiennoprzecinkowa),
- zwrócony łańcuch: 'Currency' - wartość typu Currency (walutowa),
- zwrócony łańcuch: 'Date' - wartość typu Data (data),
- zwrócony łańcuch: 'String' - wartość typu String (łańcuch),
- zwrócony łańcuch: 'Boolean' - wartość typu Boolean (logiczna True lub False),
- zwrócony łańcuch: 'Empty' - niezainicjowana,
- zwrócony łańcuch: 'Null' - brak poprawnych danych,

Przy opuszcaniu okna w zależności od wyniku sprawdzenia można zaprogramować różne działania - możliwości jest sporo, także zachęcam do wybrania tych które są programującemu przydatne.
Więcej informacji w książkach pani Snarskiej i leksykonie pana Wilczyńskiego - obydwie pozycje przedstawiam na stronie LITERATURA VBA niniejszej witryny.

Procedury dla UserForm przykładu Kliknij, żeby (roz)winąć listing

Private Sub CommandButton1_Click()
Dim Komorka As Range
Set Komorka = Arkusz1.Range("B6")

Do
Set Komorka = Komorka.Offset(1, 0)
Loop Until Komorka.Value = ""

Komorka.Value = CDbl(Format(TextBox1.Value, "0.#0"))
CommandButton2.SetFocus
End Sub

Private Sub CommandButton2_Click()
TextBox1.Value = ""
TextBox1.SetFocus
End Sub

Private Sub TextBox1_Change()
CommandButton1.Enabled = True
CommandButton2.Enabled = True
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsNumeric(TextBox1.Value) = False Then
MsgBox "Tylko wartości liczbowe ze znakiem przecinka", vbOKOnly + vbInformation, "OSTRZEŻENIE"
TextBox1.SetFocus
CommandButton1.Enabled = False
CommandButton2.Enabled = False
Else
CommandButton1.Enabled = True
CommandButton2.Enabled = True
End If
End Sub

Private Sub UserForm_Activate()
TextBox1.Value = ""
TextBox1.SetFocus
CommandButton1.Enabled = True
CommandButton2.Enabled = True
End Sub

Private Sub UserForm_Initialize()
TextBox1.Value = ""
TextBox1.SetFocus
CommandButton1.Enabled = True
CommandButton2.Enabled = True
End Sub


Bardzo częsty problem dla osób programujących - ograniczenie rodzaju danych, które są wprowadzane do okna TextBox. W punkcie omowiono wraz z przedstawieniem listingu jeden ze sposobów uporania się z tym zagadnieniem. Omówiono funkcie konwertujące VBA oraz funkcje TypeName i VarType pozwalające w dość prosty sposób uporać się z tym i podobnymi problemami programowania.

SCALANIE KOMÓREK Z CENTROWANIEM I ZAWIJANIEM TEKSTU W VBA KLIKNIJ by (roz)winąć

Bardzo proste, krótkie makro powstałe jako modyfikacja procedury rejestrowanej. Bardzo podobne działanie ma standardowy przycisk Excela. Procedurka była kilkakrotnie szukana prze użytkowników strony. W przykładzie przypisana jest do przycisku.
Plik, w którym dostępna jest w/w funkcja dostępny jest w dziale pliki niniejszej witryny. Plik jest wspólny dla tematów liczenia kolorowych komórek, liczenia i operacji na arkuszach i pętli for - each, omawianych na niniejszej stronie.
Poniżej przedstawiam kod:

Procedury scalania, wyśrodkowania i zawijania tekstu w komórce dla VBA Kliknij, żeby (roz)winąć listing

Sub Scalanie()
   With Selection
     .HorizontalAlignment = xlCenter
     .VerticalAlignment = xlCenter
     .WrapText = True
     .Orientation = 0
     .AddIndent = False
     .IndentLevel = 0
     .ShrinkToFit = False
     .ReadingOrder = xlContext
     .MergeCells = True
   End With
End Sub


Bardzo króciutki, ćwiczebny kod pozwalający nieco ułatwić sobe pracę zgodnie z tytułem punktu. Może być zastosowany jako ćwiczenie w wykorzystaniu makr Excela.

UZUPEŁNIANIE PUSTYCH KOMÓREK W TABELI ODPOWIEDNIM OZNACZENIEM KLIKNIJ by (roz)winąć

Punkt jest próbą odpowiedzi na jedno z zapytań tzn. 'uzupełnianie pustych komórek w tabeli oznaczeniem n/a w excelu'. Napisałem króciutkie makra oparte o opisywaną wyżej pętlę For ... Each. Łańcuch tekstowy wypełniający puste komórki w zakresie jest definiowalny. Ze względu na prostotę makra nie przygotowałem osobnego pliku.
Uwaga: Excel na etapie przygotowania wydruku pozwala wypełnić komórki z symbolem błędu odpowiednim wpisem (patrz Przygotowanie wydruku). Duże możliwości ma również formatowania warunkowe komórek np. przez dobór jednakowych kolorów tła i tekstu można wygasić komórki o określonych wartościach (patrz Formatowanie warunkowe). Z tych względów poniższy algorytm jest tylko propozycją realizacji postawionego zadania.
UWAGA
Przygotowałem samodzielną wtyczkę rozszerzającą możliwości Excela między innymi o zapis słowny kwoty, zliczanie ilości i wartości komórek na podstawie koloru czcionki lub tła oraz wypełnianie pustych miejsc zadanego zakresu (tabeli) odpowiednim wpisem - opis na stronie Dodatek_GK. Zastosowanie wtyczki nie wymaga umiejętności programowania.
Poniżej przedstawiam kod:

Uzupełniania pustych komórek wskazanego zakresu określonym napisem np. n/d Kliknij, żeby (roz)winąć listing

Sub Wypełnij_puste()

Dim Zaznaczony_obszar As Range
Dim Cell As Range
Dim Tekst_wypełnienia As String
Dim Adres_obszaru As String

On Error GoTo Przerwa

Adres_obszaru = Selection.Address

Set Zaznaczony_obszar = Application.InputBox _
(Prompt:="Podaj zakres do uzupełnienia pustych komórek tabeli", _
Title:="Wypełnianie pustych komórek tabeli", _
Default:=Adres_obszaru, _
Type:=8)

Tekst_wypełnienia = InputBox("Podaj tekst, którym będą wypełnione puste miejsca tabeli", _
"Puste komórki tabeli")

For Each Cell In Zaznaczony_obszar
    If Cell.Value = "" Then
    Cell.Value = Tekst_wypełnienia
    End If
Next Cell

Exit Sub
Przerwa:
End Sub

Jedną z opcji wydruku Excela jest zastępowanie komunikatu o błędach jednym z trzech zaproponowanych wyrażeń. Czasmi potrzebujemy by szybko wypełnić puste miejsca danej tabeli. Krótkie i proste makro z wykorzystaniem pętli For Each ... In ... Next realizujące wypełnianie pustych miejsc tabeli zadanym przez użytkownika ciągiem znaków.

POLECENIA OPTION KLIKNIJ by (roz)winąć

W tym punkcie zebrałem kilka występujących w tekście podstrony instrukcji VBA, które wstawione przed rozpoczęciem makra modułu wymuszają odpowiednie zachowanie programu:
- Option Explicit - wymusza deklarację zmiennych. Instrukcję można wprowadzić ręcznie lub przez zaznaczenie opcji Require Variable Declaration (menu Tools/Options i zakładka Editor) w edytorze VBA. Brak wymuszania wprowadzania zmiennych powoduje że nie zadeklarowanej zmienney automatycznie przypisywany jest typ Variant. Pozornie jest to wygodne, ale często wolniejsze i w przypadku sprawdzania kodu utrudnia znajdowanie błędów.
- Option Base 1 - przy deklarowaniu tablic interpreter języka VBA przyjmuje domyślnie, że dolny indeks ma wartość 0. Deklaracja:
Dim Moja_tablica(100) As Integer
oznacza w tym wypadku tablicę o 101 elementach. Tablicę o równo stu liczbach całkowitych można zadeklarować poleceniem:
Dim Moja_tablica(1 To 100)
Jeżeli chcemy by dla wszystkich tablic interpreter VBA przyjmował domyślnie dolny indeks o wartości 1 należy na początku modułu użyć instrukcji Option Base 1
- Option Compare Text - instrukcja powoduje, że interpreter VBA nie rozróżnia dużych i małych liter przy porównywaniu łańcuchów tekstowych.

Punkt przydatny dla początkujących użytkownikóe VBA. Omawia podstawowe instrukcje: Option Explicit (wymuszanie deklarowania zmiennych), Option Base 1 (zmiana domyslnego sposobu numerowania elementów tablicy) i Option Compare Text (eliminacja rozróżniania małyc i wielkich liter w ciągach tekstowych).

ODŚWIEŻANIE EKRANU I KLAWISZE CTRL+BREAK KLIKNIJ by (roz)winąć

Poniżej przedstawiam dwie małe instrukcje przydatne przy pisaniu własnych aplikacji
a) wyłączenie aktualizacji ekranu na czas działania procedury i włączenie po jej zakończeniu może przyspieszyć działanie makra, a w przypadku stosowania z poziomu VBA poleceń typu kopiuj/wklej itp. wyłączy irytujące migotanie ekranu (chociaż miałem już odbiorcę aplikacji, który zażądał pozostawienia migotania, stwierdzając że wtedy wie że program się nie zawiesił tylko pracuje ;)
Application.ScreenUpdating = False

b) wyłączenie kombinacji klawisz Ctrl+Break służącej do zatrzymywania działania makra:
Application.EnableCancelKey = xlDisabled
Przy czym należy zauważyć, że zastosowanie tego typu polecenia przy niesprawdzonym dokładnie makrze, które wykonuje pętlę nieskończoną uniemożliwi przerwanie takiej jałowej operacji.

Efektem niektórych procedur VBA jest migotanie ekranu związane z odświeżaniem. W punkcie przedstawiono sposób eliminacji tego - przez wielu traktowanego jako przykry - efektu na czas działania makra. Dodatkowo przedstawiono sposób na wyłączenie podstawowego skrótu klawiaturowego VBA tj. Ctrl + Break powodującego przerwanie działania makra.

FORMULARZ POWITALNY I ZABLOKOWANIE PRZYCISKU 'X' I MODALNOŚĆ USERFORM KLIKNIJ by (roz)winąć

Trzy drobne przykłady zaczerpnięte z książki Walkenbacha dotyczące elementów zastosowania formularzy UserForm:

Formularz powitalny widoczny po otwarciu pliku i zamykany automatycznie po upływie np. pięciu sekund:

Dla zdarzenia obiektu ThisWorkbook:
Private Sub Workbook_Open()
UserForm1.Show
End Sub

Dla zdarzenia Userform1
Private Sub UserForm_Activate()
Application.OnTime Now + TimeValue("00:00:05"), "Zamknij_powitanie"
End Sub

W module podstawowym skoroszytu (np. Module1):
Sub Zamknij_powitanie()
Unload UserForm1
End Sub


Wyłączanie przycisku Zamknij (ikona "X" w prawym górnym rogu) formularza UserForm
Całkowite wyłączenie ikony "X" możliwe jest tylko z wykorzystaniem funkcji API. Prostszy sposób zaproponowany przez pana Walkenbacha polega na odpowiednim oprogramowaniu zdarzenia QueryClose:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Aby zamknąć okno użyj dedykowanego przycisku"
Cancel = True
End If
End Sub

Private Sub CommandButton1_Click()
Unload UserForm2
End Sub

Procedura UserForm_QueryClose używa dwóch argumentów. Argument CloseMode zawiera wartość identyfikującą przyczynę wystąpienia zdarzenia QueryClose. Jeśli wartością jest vbFormControlMenu (wbudowana stała), oznacza to, że użytkownik kliknął przycisk Zamknij. W takim przypadku zostanie wyświetlony komunikat, a wartość argumentu Close ustawiana jest na True i formularz faktycznie nie jest zamykany. Działanie formularza (jako makra) można przerwać kombinacją klawiszy Ctrl+Break. Sposób na wyłączenie tej kombinacji klawiszy jest przedstawiony na tej stronie.


Formularz UserForm otwarty podczas wykonywania innych działań
Domyślnie formularze UserForm są modalne tzn. do czasu ich zamknięcia nie jest możliwe wykonywanie innych działań. Począwszy od Excela 2000 możliwe jest określenie modalności formularza przez użycie stałej vbModeless jako argumentu metody Show np. UserForm2.Show vbModeless Instrukcja ta spowoduje, że możliwa jest praca na innych elementach np. wprowadzanie danych do arkusza przy pozostawionym otwartym formularzu.

Punkt przedstawia kilka zagadnień często szukanych przez osoby piszące swe aplikacje:
- sposób na stworzenie formularza powitalnego, pojawiającego się po otwarciu pliku i wyłączającego się samoczynnie - przydatne, gdy chcemy by nasza aplikacja wyglądała bardziej profesjonalnie,
- sposób na eliminację zamykania formularza krzyżykiem w prawym, górnym rogu - przydatne gdy chcemy np. wymusić wprowadzanie danych,
- sposób na zmianę modalności formularza - w sytuacji gdy chcemy by przy otwartym formularzu można było wprowadzać dane do arkusza.

WYŁĄCZENIE OBSŁUGI ZDARZEŃ VBA KLIKNIJ by (roz)winąć

W Excelu obsługa zdarzeń domyślnie jest włączona co czasami powoduje powstanie pętli kaskadowych np.
- przy zmianie zawartości kontrolki TextBox (zdarzenie Change) następuje sprawdzenie jej danych w przypadku wartości spoza zakresu następuje wyświetlenie komunikatu i wyzerowanie kontrolki. wymazywanie zawartości kontrolki za pomocą kodu VBA generuje kolejne zdarzenie Change itd.
- w przypadku w którym dla arkusza zdefiniowano zdarzenie Worksheet_Change monitorujące komórki zadanego zakresu i sprawdzające czy wprowadzono liczbę mniejszą lub większą 10. Jeżeli liczba jest spoza zakresu nastąpi wyzerowanie zawartości komórki. Zerowanie generuje kolejne zdarzenie Change itd.

Wyłączenie obsługi zdarzeń dla arkusza następuje po wykonaniu instrukcji:
Application.EnableEvents = False
Włączenie po wykonaniu w/w instrukcji z wartością True

I tutaj małe uwagi:
- wyłączenie obsługi zdarzeń nie ma wpływu na zdarzenia generowane przez kontrolki formularzy Userform,
- wyłączenie obsługi zdarzeń dotyczy wszystkich skoroszytów, nie tylko skoroszytu aktywnego

W swoich programach aby monitorować obsługę zdarzeń ustalałem jedną komórkę kontrolną w arkuszu pomocniczym. Zdarzenie było wykonywane tylko gdy zawartość w tej komórce odpowiadała warunkom. Po wykonaniu zdarzenia zawartość komórki była zmieniana. W ten sposób zdarzenie mogło wystąpić tylko w określonych przez autora aplikacji warunkach. Jest to metoda dobra, ale mało elegancka. W książce Walkenbacha znalazłem zbliżoną propozycję.
Autor deklaruje zmienną statyczną typu Boolean na początku procedury obsługi zdarzeń:
Static Obsługa_zdarzeń As Boolean

Kiedy procedura ma wykonać zmiany, zmienną trzeba ustawić na wartość True. Po zakończeniu procedury zmienna ustawiana jest z powrotem na wartość False.

If Obsługa_zdarzeń Then
Obsługa_zdarzeń = False
Exit Sub
End If

Wejście do procedury następuje tylko dla wartości True. Ustawienie zmiennej na False zapobiega powstaniu pętli kaskadowej.

Obsługa zdarzeń jest bardzo przydatną, ale często trudną do opanowania możliwością VBA. Zdarza się, że trudno jest nam skontrolować, które działania generować będą zdarzenia kontrolek. Przydatna jest wtedy możliwość przynajmniej chwilowego wyłączenia obsługi zdarzeń - makro stanowi załącznik tego punktu.

AUTOMATYCZNA ZMIANA NAZWY NOWEGO ARKUSZA KLIKNIJ by (roz)winąć

Realizacja zadania wymaga wprowadzenia krótkiej procedury dla zdarzenia NewSheet. Procedura jest wykonywana gdy do skoroszytu (pliku) Excela dodawany jest nowy arkusz (przekazywany do procedury jako jej argument) Procedura sprawdzi typ arkusza i dla sprawdzonego warunku poprosi o podanie nazwy. W przypadku nazwy błędnej przyjęta zostanie nazwa domyślna
Private Sub Workbook_NewSheet(ByVal Sh As Object)
On Error GoTo Błąd:
If TypeName(Sh) = "Worksheet" Then
Sh.Name = InputBox("Podaj nazwę nowego arkusza", "NOWY ARKUSZ", "Arkusz")
End If
Exit Sub
Błąd:
MsgBox ("Wystąpił błąd - nadana zostanie nazwa domyślna")
End Sub

Oczywiście nazwa nowego arkusza nie musi być podawana w oknie InputBox, a może np zostać pobrana z wcześniej przygotowanej tabeli.

Przydante makro opierające się na obsłudze zdarzenia związanego ze wstawianiem nowego arkusza do skoroszytu - pozwala wymusić wprowadzenie nazwy nowego obiektu. Przydatne przy niektórych rozwiązaniach aplikacji.

MAKRO WYWOŁYWANE O OKREŚLONEJ PORZE - ZDARZENIE ONTIME KLIKNIJ by (roz)winąć

Jest to jedno z dwóch zdarzeń, które nie są powiązane z obiektami. Definiowane są w modułach ogólnych (nie modułach klasy)
Zdarzenie OnTime występuje o określonej porze dnia np.
Zdarzenie występujące o określonej porze dnia:

Sub Koniec_pracy()
Application.OnTime TimeValue("17:00:00"), "Sygnał"
End Sub

Sub Sygnał()
MsgBox "Kończ Waść, wstydu oszczędź - czas kończyć pracę"
End Sub

W procedurze Koniec_pracy wykorzystano metodę OnTime obiektu Application i dla wartości TimeValue równą 17 wywoła procedurę "Sygnał". Procedura ta wyświetli komunikat.

Zdarzenie następujące po pewnym czasie do czasu bieżącego:
Application.OnTime Now + TimeValue("00:15:00") , "Sygnał"

Zdarzenie następujące o określonej godzinie określonego dnia:
Application.OnTime DateSerial(2009,9,1) + TimeValue("08:00:00"), "Sygnał"

W książce Walkenbacha znajduje się przykład procedury zawierającej powtarzające się zdarzenie (np. co pięć sekund).
Nieco wyżej podany jest przykład zastosowania formularza powitalnego, gdzie zastosowano tę samą metodę OnTime.

Opis jednego z dwóch zdarzeń niezwiązanych obiektami - wywoływanie makra o określownej porze dnia np. przed końcem pracy przypomnienie o zapisaniu plików. Raczej dla żartów, ale same makro ciekawe.

BLOKADA MENU PODRĘCZNEGO KLIKNIJ by (roz)winąć

Jeżeli chcemy wyłączyć w naszej aplikacji menu podręczne (dostępne po kliknięciu prawym przyciskiem myszy) można wykorzystać zdarzenie BeforeRightClick dostępne dla całego skoroszytu (This Workbook) lub dla poszczególnych arkuszy (Worksheet) można wykorzystać następującą procedurę:

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox ("Menu podręczne nie jest dostępne")
End Sub

Prawym klawiszem myszy w trakcie pracy w arkuszu uruchamiamy menu podręczne. Jeżeli ze względu na funkcje realizowanej aplikacji chcemy to menu wyłączyć można zastosować makro z tego punktu.

CZYSZCZENIE SCHOWKA OFFICE'A Z POZIOMU VBA KLIKNIJ by (roz)winąć

Jeżeli w aplikacji dokonujemy kopiowania zakresów, tekstu, elementów graficznych przy próbie zamknięcia wyświetlony zostanie komunikat o zapełnionym schowku. Ze względu między innymi na uproszczenia obsługi schowek Office'a powinien zostać wyczyszczony przed zamknięciem aplikacji. Najprostszym sposobem jest skopiowanie pustej komórki poleceniem:
Arkusz1.Range("A1").Copy

Jeżeli nasz kod VBA kopiuje elementy arkusza lub obiekty graficzne przy wyjściu z aplikacji trudno jest uniknąć pytania ze strony Excela "czy zachować dane w schowku". Eleganckim rozwiązaniem jest wyczyszczenie schowka przed wyjściem z aplikacji. Banalnie proste rozwiązanie przedstawione jest w tym punkcie.

INFORMOWANIE UŻYTKOWNIKA ŻE MAKROPOLECENIE JEST WYKONYWANE KLIKNIJ by (roz)winąć

W sytuacji gdy działanie makra zabiera odczuwalną przez użytkownika ilość czasu, brak komunikatu na ekranie wprowadza nieco zamieszania - nie waiadomo czy program się zawiesił czy pracowicie przelicza. Dla prostych makropoleceń, gdzie wprowadzanie paska postępu zadania w formie graficznej byłoby przerostem formy nad treścią można wykorzystać pasek stanu z jednoczesną zmianą formy kursora na znaną użytkownikowi 'klepsydrę'. Można posłużyć się następującą konstrukcją:
Sub Makro_nagrywanie
Application.DisplayStatusBar = True 'włączamy pasek stanu - nie zawsze jest widoczny

With Application
.ScreenUpdating = False 'wyłączamy odświeżanie ekranu - nie będzie mrugał
.Cursor = xlWait 'znak kursora zamieniamy na klepsydrę
.StatusBar = "Czekaj... - trwa nagrywanie" 'wyświetlamy napis na pasku stanu
End With

ActiveWorkbook.Save

With Application
.ScreenUpdating = True 'włączamy odświeżanie ekranu
.Cursor = xlDefault 'przywracamy standardowy znak kursora
.StatusBar = False 'likwidujemy napis z paska postępu
End With

End Sub

Oczywiście można pierwszą instrukcję włączyć do konstrukcji With ... End With lub każde polecenie pisać w osobnej linii.

Jeżeli wykonanie makra trwa długo (np. nagranie aktywnego skoroszytu) wypada poinformować użytkownika, że program się nie zawiesił tylko pracuje. W dość elegancki i prosty sposób można to wykonać przez zmianę symbolu kursora i wyświetlenie odpowiedniego napisu na pasku stanu.

Spis artykułów Frazy Google Przykłady makr Do strony głównej