Archiwum kategorii: Excel VBA

Jak z VBA wywołać okno dialogowe do pobrania nazwy pliku od użytkownika

Opublikowany przez
10

Pod Excelem można to zrobić na dwa sposoby:
Korzystając z biblioteki Office (funkcja bardzo podobna do WskazFolder):

Function WskazPlik(TytulOkna As String, TytulPrzycisku As String) As String
    Dim Okno As FileDialog
    Dim Wybrane As String
    Set Okno = Application.FileDialog(msoFileDialogFilePicker)
    Okno.Title = TytulOkna
    Okno.ButtonName = TytulPrzycisku
    If Okno.Show = -1 Then
        WskazPlik = Okno.SelectedItems(1)
    End If
End Function

Lub korzystając z metody Excela:

Function WskazPlik_MetodaExcel() As String
    WskazPlik_MetodaExcel = Excel.Application.GetOpenFilename()
End Function

Pierwsza funkcja jest nieco bardziej skomplikowana ale bardziej uniwersalna, druga jest skrajnie prosta i nie wymaga niczego poza Excelem. Oczywiście obie można rozbudować o możliwość filtrowania plików…

W komentarzach znajduje się dyskusja na temat konstrukcji wiążącej With..End With

Jak zacząć programowanie w VBA w Excelu?

Opublikowany przez
4

Trzeba zacząć od dodania do Wstążki karty Deweloper. Karta Plik, zwana też dla zmylenia przeciwnika widokiem Backstage, pozwala oczywiście zarządzać plikiem (zapisywanie, drukowanie, właściwości itp.). Znajdziemy tu także opcje Excela. I właśnie te opcje nas teraz interesują.
Po wejściu w Opcje wybieramy Dostosowywanie Wstążki i zaptaszamy wybór karty Deweloper. Po zatwierdzeniu możemy obejrzeć nowo dodaną kartę, a na niej stare dobre przyciski ze starego dobrego paska Visual Basic (i komu on przeszkadzał?).

Tu przede wszystkim interesujemy się Bezpieczeństwem Makr, które w zdecydowanej większości przypadków powinniśmy zostawić w domyślnej opcji – Wyłącz wszystkie makra i wyświetl powiadomienie (dawny średni poziom zabezpieczeń). Pozwoli nam to na podjęcie decyzji czy włączyć makra po otwarciu pliku je zawierającego.

Kolejny ruch to zapisanie pliku jako Skoroszyt programu Excel z obsługą makr, bo tylko w takim typie pliku możemy zapisać kod pod Excelem 2007/2019. I to z grubsza tyle, możemy sobie teraz nagrać i edytować jakieś makro, czyli procedurę publiczną VBA. Możemy też napisać jakąś własną funkcję publiczną i używać jej jak funkcji wbudowanej Excela. Co bardziej ambitni mogą oprogramować zdarzenia skoroszytu czy arkusza a najbardziej wytrwali mogą nawet zaprojektować i oprogramować własny formularz. Powodzenia!
Jeszcze jedna uwaga. Gdyby przyszło nam do głowy rozpowszechniać kod w postaci szablonu musimy pamiętać aby zapisać plik jako Szablon programu Excel z obsługą makr

Odwieczny problem: Funkcja Slownie

Opublikowany przez
74

Jak na razie to największy kawałek kodu na tej stronie. Funkcja Slownie, czyli zamieniająca kwotę na jej słowny odpowiednik nie jest dostępna w Excelu ani w żadnej innej aplikacji Microsoft Office (o ile mi wiadomo).

I tu korekta (jak sądzę). W komentarzu pod tym artykułem znajduje się funkcja działająca w SQL Server Reporting Services. Komentarz autorstwa Pana Adama.

Oczywiście w Sieci można znaleźć wiele przykładów jej implementacji ale cóż warta byłaby strona o VBA, gdyby jej tu nie można było znaleźć. Wszelkie wytknięte błędy i konstruktywne uwagi krytyczne będą mile widziane (dwa błędy już zostały wykryte i poprawione). Funkcja korzysta z dwóch pomocniczych funkcji prywatnych, bez których nie będzie działać. Oto kod:

 
Option Explicit
 
Function Slownie(Kwota As Variant) As String
   '==================================
    ' UWAGA! Funkcja wymaga obu funkcji
    ' prywatnych zamieszczonych poniżej
    '==================================
 
    Const WERSJA As String = _
        "Funkcja Słownie v.1.02 (Akademia-VBA.pl)"
 
    Dim Opis(19) As String
    Dim DziesOpis(2 To 10) As String
    Dim SetOpis(1 To 9) As String
 
    Dim Zlotowki As String
    Dim Grosze As String
 
    Dim TrojkaZl As String
    Dim TrojkaTys As String
    Dim TrojkaMln As String
 
    Dim wynikGrosze As String
    Dim wynikZlote As String
    Dim Ujemna As Boolean
 
    On Error GoTo Obsluga
 
    'sprawdzenie czy puste
    If IsNull(Kwota) Or IsEmpty(Kwota) Then
        Slownie = "# Brak kwoty!"
        Exit Function
    End If
 
    'sprawdzenie czy liczba
    If Not IsNumeric(Kwota) Then
        Slownie = "# Nieprawidłowy typ wartości!"
        Exit Function
    End If
 
    'gdy ujemna
    If Kwota < 0 Then
        Ujemna = True
        Kwota = -Kwota
    End If
 
    'konwersja na stringi
    Zlotowki = CStr(Int(Kwota))
    Grosze = CStr(Kwota - Int(Kwota))
 
    'sprawdzenie, czy nie za duża, max 99 mln
    If Len(Zlotowki) > 9 Then
        Slownie = "# Kwota za duża, max 999 mln!"
        Exit Function
    End If
 
    'ewentualne zaokrąglenie do 2 msc po przecinku
    'tu drobna poprawka stąd wersja 1.01
    'było ...= CStr(Round(CDbl(Grosze) * 100, 2))
    If Len(Grosze) > 2 Then
        Grosze = CStr(Round(CDbl(Grosze), 2) * 100)
    End If
 
    'kod zasadniczy
    '==============
    Select Case Len(Zlotowki)
    Case 1 To 3
        wynikZlote = Trojka(Zlotowki) & _
            OpisRzeduWielkosci(CLng(Zlotowki), "zł", False)
    Case 4 To 6
        TrojkaZl = Right(Zlotowki, 3)
        TrojkaTys = Left(Zlotowki, Len(Zlotowki) - 3)
        wynikZlote = Trojka(TrojkaTys) & _
            OpisRzeduWielkosci(CLng(TrojkaTys), "tys", True) _
            & " " & Trojka(TrojkaZl) & _
            OpisRzeduWielkosci(CLng(TrojkaZl), "zł", True)
    Case 7 To 9
        TrojkaZl = Right(Zlotowki, 3)
        TrojkaTys = Mid(Zlotowki, Len(Zlotowki) - 5, 3)
        TrojkaMln = Left(Zlotowki, Len(Zlotowki) - 6)
        wynikZlote = Trojka(TrojkaMln) & _
            OpisRzeduWielkosci(CLng(TrojkaMln), "mln", True) _
            & " " & Trojka(TrojkaTys) & _
            OpisRzeduWielkosci(CLng(TrojkaTys), "tys", True) _
            & " " & Trojka(TrojkaZl) & _
            OpisRzeduWielkosci(CLng(TrojkaZl), "zł", True)
    End Select
 
    wynikGrosze = Trojka(Grosze) & _
        OpisRzeduWielkosci(CLng(Grosze), "gr", False)
 
    If wynikGrosze = "" Then wynikGrosze = "zero groszy"
 
    Slownie = IIf(Ujemna, "minus ", "") & _
        Trim(wynikZlote & " " & wynikGrosze)
 
    Exit Function
Obsluga:
    MsgBox Err & " - " & Err.Description, vbCritical, WERSJA
End Function
 
Private Function OpisRzeduWielkosci( _
        Liczba As Long, RzadWielkosci As String, _
        WiekszeTysiac As Boolean) As String
 
    Dim JestZero As Boolean
    Dim DwieOstatnie As Long
    Dim Ostatnia As Long
 
    If Liczba = 0 Then
        If WiekszeTysiac Then
            If RzadWielkosci = "zł" Then
                OpisRzeduWielkosci = "złotych"
            End If
        Else
            OpisRzeduWielkosci = ""
        End If
        Exit Function
    End If
 
    DwieOstatnie = CLng(Right(CStr(Liczba), 2))
    Ostatnia = CLng(Right(CStr(Liczba), 1))
 
    Select Case RzadWielkosci
    Case "gr"
        Select Case DwieOstatnie
        Case 0, 5 To 19
            OpisRzeduWielkosci = " groszy"
        Case 1
            OpisRzeduWielkosci = " grosz"
        Case 2 To 4
            OpisRzeduWielkosci = " grosze"
        Case Is > 19
            Select Case Ostatnia
            Case 0, 1, Is > 4
                OpisRzeduWielkosci = " groszy"
            Case 2 To 4
                OpisRzeduWielkosci = " grosze"
            End Select
        End Select
    Case "zł"
        Select Case DwieOstatnie
        Case 0, 5 To 19
            OpisRzeduWielkosci = " złotych"
        Case 1
            OpisRzeduWielkosci = " złoty"
        Case 2 To 4
            OpisRzeduWielkosci = " złote"
        Case Is > 19
            Select Case Ostatnia
            Case 0, 1, Is > 4
                OpisRzeduWielkosci = " złotych"
            Case 2 To 4
                OpisRzeduWielkosci = " złote"
            End Select
        End Select
    Case "tys"
        Select Case DwieOstatnie
        Case 0, 5 To 19
            OpisRzeduWielkosci = " tysięcy"
        Case 1
            OpisRzeduWielkosci = " tysiąc"
        Case 2 To 4
            OpisRzeduWielkosci = " tysiące"
        Case Is > 19
            Select Case Ostatnia
            Case 0, 1, Is > 4
                OpisRzeduWielkosci = " tysięcy"
            Case 2 To 4
                OpisRzeduWielkosci = " tysiące"
            End Select
        End Select
    Case "mln"
        Select Case DwieOstatnie
        Case 0, 5 To 19
            OpisRzeduWielkosci = " milionów"
        Case 1
            OpisRzeduWielkosci = " milion"
        Case 2 To 4
            OpisRzeduWielkosci = " miliony"
        Case Is > 19
            Select Case Ostatnia
            Case 0, 1, Is > 4
                OpisRzeduWielkosci = " milionów"
            Case 2 To 4
                OpisRzeduWielkosci = " miliony"
            End Select
        End Select
    End Select
End Function
 
Private Function Trojka(strLiczba As String) As String
    Dim lngLiczba As Long
    Dim lngOstatnia As Long
    Dim lngDwieOstatnie As Long
 
    Dim Opis(19) As String
    Dim DziesOpis(10) As String
    Dim SetOpis(9) As String
 
    If CLng(strLiczba) = 0 Then
        Trojka = ""
        Exit Function
    End If
 
    Opis(0) = "zero"
    Opis(1) = "jeden"
    Opis(2) = "dwa"
    Opis(3) = "trzy"
    Opis(4) = "cztery"
    Opis(5) = "pięć"
    Opis(6) = "sześć"
    Opis(7) = "siedem"
    Opis(8) = "osiem"
    Opis(9) = "dziewięć"
    Opis(10) = "dziesięć"
    Opis(11) = "jedenaście"
    Opis(12) = "dwanaście"
    Opis(13) = "trzynaście"
    Opis(14) = "czternaście"
    Opis(15) = "piętnaście"
    Opis(16) = "szesnaście"
    Opis(17) = "siedemnaście"
    Opis(18) = "osiemnaście"
    Opis(19) = "dziewiętnaście"
 
    DziesOpis(0) = "zero"
    DziesOpis(1) = "dziesięć"
    DziesOpis(2) = "dwadzieścia"
    DziesOpis(3) = "trzydzieści"
    DziesOpis(4) = "czterdzieści"
    DziesOpis(5) = "pięćdziesiąt"
    DziesOpis(6) = "sześćdziesiąt"
    DziesOpis(7) = "siedemdziesiąt"
    DziesOpis(8) = "osiemdziesiąt"
    DziesOpis(9) = "dziewięćdziesiąt"
 
    SetOpis(0) = "zero"
    SetOpis(1) = "sto"
    SetOpis(2) = "dwieście"
    SetOpis(3) = "trzysta"
    SetOpis(4) = "czterysta"
    SetOpis(5) = "pięćset"
    SetOpis(6) = "sześćset"
    SetOpis(7) = "siedemset"
    SetOpis(8) = "osiemset"
    SetOpis(9) = "dziewięćset"
 
    lngLiczba = CLng(strLiczba)
 
    'tu policzymy ostatnią
    lngOstatnia = CLng(Right(strLiczba, 1))
 
    Select Case lngLiczba
    Case Is < 20
        Trojka = Opis(lngLiczba)
    Case Is < 100
        If lngLiczba Mod 10 = 0 Then
            Trojka = DziesOpis(lngLiczba / 10)
        Else
            Trojka = DziesOpis((lngLiczba - lngOstatnia) / 10) _
                & " " & Opis(lngOstatnia)
        End If
    Case Else 'trzycyfrowa
        If lngLiczba Mod 100 = 0 Then
            Trojka = SetOpis(lngLiczba / 100)
        Else
            'tu policzymy dwie ostatnie
            lngDwieOstatnie = CLng(Right(strLiczba, 2))
 
            If lngLiczba Mod 10 = 0 Then
                Trojka = SetOpis((lngLiczba - lngDwieOstatnie) / 100) _
                    & " " & DziesOpis(lngDwieOstatnie / 10)
            Else
                If lngDwieOstatnie < 20 Then
                    Trojka = SetOpis((lngLiczba - lngDwieOstatnie) / 100) _
                        & " " & Opis(lngDwieOstatnie)
                Else
                    Trojka = SetOpis((lngLiczba - lngDwieOstatnie) / 100) _
                        & " " & DziesOpis((lngDwieOstatnie - lngOstatnia) / 10) _
                        & " " & Opis(lngOstatnia)
                End If
            End If
        End If
    End Select
End Function

CurrentRegion bez nagłówka

Opublikowany przez
Odpowiedz

Często potrzebujemy obiektu prawie identycznego z bieżącym zakresem, ale bez wiersza nagłówkowego. Oczywiście można go za każdym razem obliczyć na podstawie właściwości obiektu Range, lub zrobić to raz i zapisać w postaci funkcji

Function BiezacyZakresBezNaglowka() As Excel.Range
 
    'Oczywiscie zakładamy,
    'że komórka aktywna jest w zakresie
 
    Dim Zakres As Range
    Dim LW As Long, LK As Long
 
    Set Zakres = ActiveCell.CurrentRegion
    LW = Zakres.Rows.Count
    LK = Zakres.Columns.Count
    Set BiezacyZakresBezNaglowka = _
        Range(Zakres.Cells(2, 1), Zakres.Cells(LW, LK))
 
End Function
 
Sub TestFunkcji()
 
    'dla sprawdzenia pokolorujemy
    BiezacyZakresBezNaglowka.Interior.ColorIndex = 34
 
End Sub

Sprawdzenie, czy użytkownik ustawił komórkę aktywną w zakresie danych

Opublikowany przez
2

Często występującym problemem jest próba uruchomienia kodu wymagającego zakresu danych, w czasie gdy użytkownik:

  • nie ustawił się w zakresie danych (stoi w pustej komórce poza zakresem)
  • nie uaktywnił właściwego typu arkusza (np stoi w arkuszu typu wykres)
  • nie uaktywnił właściwego typu okna (np stoi na oknie wykresu osadzonego w arkuszu)

Tu z pomocą mogą przyjść nam 3 sprawdzające to funkcje logiczne:

Option Explicit
Public Const WERSJA = "Wykresy VBA v.0.1 (Akademia-VBA.pl)"
 
Private Function NienormalnyArkusz() As Boolean
    If ActiveSheet.Type <> xlWorksheet Then
        MsgBox "Ustaw się w arkuszu danych!", vbExclamation, WERSJA
        NienormalnyArkusz = True
    End If
End Function
 
Private Function NienormalneOkno() As Boolean
    If ActiveWindow.Type <> xlWorkbook Then
        MsgBox "Ustaw się w oknie danych!", vbExclamation, WERSJA
        NienormalneOkno = True
    End If
End Function
 
Private Function BrakZakresu() As Boolean
    If Len(ActiveCell) = 0 Then
        MsgBox "Ustaw się w niepustej komórce zakresu danych!", vbExclamation, WERSJA
        BrakZakresu = True
    End If
End Function

Takie funkcje bardzo upraszczają kod procedury głównej, w naszym przypadku uruchamiającej formularz generujący wykresy. Powinny być raczej prywatne, ponieważ nie są zbyt przydatne jako funkcje arkuszowe

Sub UruchomFormularz()
    If NienormalnyArkusz Then Exit Sub
    If NienormalneOkno Then Exit Sub
    If BrakZakresu Then Exit Sub
    fmWykresy.Show
End Sub

Przywrócenie zarządzania właściwością StatusBar Excelowi

Opublikowany przez
Odpowiedz

Często używamy właściwości StatusBar do wyświetlania komunikatów o postępie wykonywania zadań w aplikacji. Po zakończeniu po prostu zwykle przywracałem domyślny dla polskiego Excela komunikat:

'---
Application.StatusBar = "Gotowy" 
'---

Jednak kolega tfz zwrócił uwagę, że lepiej po prostu oddać zarządzanie właściwością StatusBar z powrotem Excelowi, przypisując mu wartość False:

'---
Application.StatusBar = False 
'---

Jest to zdecydowanie lepsze rozwiązanie, bo przywraca status w brzmieniu zgodnym z wersją językową Excela

Scalacz – aplikacja do automatycznej konsolidacji danych z wielu skoroszytów

Opublikowany przez
71

Tym razem nieco większa porcja kodu. Jest to w miarę kompletna aplikacja, gotowa do użycia. Wystarczy skopiować poniższy kod do modułu publicznego w Excelu (Alt+F11, Insert – Module). Aplikacja konsoliduje dane z wielu skoroszytów i zapisuje je w zbiorczym, nowo tworzonym arkuszu. Przed użyciem proszę uważnie przeczytać założenia

Public Const WERSJA As String = "Scalacz v.1.0 (Akademia-VBA.pl)"
 
' ==================================================
' ZAŁOŻENIA:
' 1. Wszystkie skoroszyty do scalenia znajdują się w jednym folderze
' 2. Nie ma tam żadnych skoroszytów przypadkowych (w tym docelowego)
' 3. Dane do scalenia są zawsze w pierwszym arkuszu i mają jednakowe kolumny
' 4. Dane do scalenia mają nagłówki
' ==================================================
 
Sub Scalaj()
    Dim Skonsolidowany As Worksheet
    Dim Plik As String
    Dim Skor As Workbook, Ark As Worksheet
    Dim Pocz As Range, Kon As Range
    Dim Naglowki As Range, Podzakres As Range, KomDocel As Range
    Dim Licznik As Long, LW As Long, LK As Long
    Dim ZakresDocel As Range, LW_Docel As Long
    Dim Folder As String
 
    Folder = WskazFolder("Wskaż folder z plikami do scalenia", "Scalaj")
    If Len(Folder) = 0 Then
        MsgBox "Nie wskazano foldera źródłowego", vbExclamation, WERSJA
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set Skonsolidowany = Worksheets.Add()
    Plik = Dir(Folder & "*.xls")
    Do Until Len(Plik) = 0
        Licznik = Licznik + 1
        Application.StatusBar = "Konsolidacja pliku nr " & Licznik
        Set Skor = Workbooks.Open(Folder & Plik)
        Set Ark = Skor.Sheets(1)
        If Licznik = 1 Then
            Set Naglowki = Ark.Range("A1").CurrentRegion.Rows(1)
            Naglowki.Copy Skonsolidowany.Range("A1")
            Set KomDocel = Skonsolidowany.Range("A2")
        Else
            Set ZakresDocel = Skonsolidowany.Range("A1").CurrentRegion
            LW_Docel = ZakresDocel.Rows.Count
            Set KomDocel = Skonsolidowany.Cells(LW_Docel + 1, 1)
        End If
        Set Podzakres = Ark.Range("A1").CurrentRegion
        LW = Podzakres.Rows.Count
        LK = Podzakres.Columns.Count
        Set Podzakres = Range(Ark.Range("A2"), Ark.Cells(LW, LK))
        Podzakres.Copy KomDocel
        Skor.Close False
        Plik = Dir
    Loop
    Skonsolidowany.Name = "Skonsolidowany" & StempelCzasowy
    Skonsolidowany.UsedRange.EntireColumn.AutoFit
    Skonsolidowany.Range("A1").Select
    'Application.StatusBar = "Gotowy"
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox "Konsolidacja " & Licznik & " arkuszy zakończona", vbInformation, WERSJA
End Sub
 
Function StempelCzasowy() As String
    StempelCzasowy = Format(Now(), "_yyyymmdd_hhmmss")
End Function
 
Function WskazFolder(TytulOkna As String, TytulPrzycisku As String) As String
    Dim Okno As FileDialog
    Dim Wybrane As String
    Set Okno = Application.FileDialog(msoFileDialogFolderPicker)
    Okno.Title = TytulOkna
    Okno.ButtonName = TytulPrzycisku
    If Okno.Show = -1 Then
        Wybrane = Okno.SelectedItems(1)
        If Right(Wybrane, 1) <> "\" Then
            WskazFolder = Wybrane & "\"
        Else
            WskazFolder = Wybrane
        End If
    End If
End Function

Zabezpieczenia makr, poziomy zabezpieczeń

Opublikowany przez
Odpowiedz

Na szczęście makrowirusy nie są ostatnio bardzo popularne, ale proszę zawsze uważać, lepiej dmuchać na zimne. Poziom zabezpieczeń ustawiamy z menu – Narzędzia – Makro – Zabezpieczenia.

Nie wolno ustawiać niskiego poziomu zabezpieczeń, ponieważ wtedy każdy uruchomiony plik zawierający makro, będzie mógł je bez pytania uruchomić. W większości przypadków należy użyć średniego poziomu zabezpieczeń, który gwarantuje zadanie pytania czy włączyć makra, przy uruchamianiu pliku. Proszę się dobrze zastanowić przed odpowiedzią na to pytanie!

Nigdy nie należy włączać makr w obcym nieznanym pliku!

Zabezpieczenia wysokie i bardzo wysokie stosujemy tylko gdy mamy wykupiony certyfikat bezpieczeństwa do projektu VBA co się raczej rzadko zdarza

Jak skorzystać z kodu VBA znalezionego w Internecie

Opublikowany przez
Odpowiedz

Dla początkujących może być to poważny problem. Przede wszystkim trzeba ocenić czy przypadkiem kod nie jest szkodliwy. Na szczęście w przypadku kodu VBA jest to bardzo rzadko spotykane. Po drugie trzeba rozróżnić czy jest to kod do umieszczenia w module publicznym, czy prywatnym module formularza, raportu, skoroszytu czy arkusza.

Moduł publiczny wstawiamy z menu Instert – Module (wcześniej Alt-F11 aby otworzyć edytor VBA). Tu wklejamy funkcje, które mają być dostępne z poziomu funkcji użytkownika w Excelu czy też w każdej kwerendzie, raporcie czy formularzu w Accessie (np wrzucamy tu funkcję Slownie, jeżeli chcemy aby była powszechnie dostępna w całej bazie)

Moduł prywatny zawsze związany jest z jakimś obiektem. Tylko tu możemy umieścić kod automatycznie wykonujący się z powodu zdarzeń generowanych przez użytkownika takich jak otwarcie czy zamknięcie dokumentu, lub kliknięcie w przycisk. Jeżeli widzimy kod bezpośrednio odwołujący się do kontrolek na formularzu, jak np poniższe dwie procedury:

Private Sub UserForm_Initialize()
 
    przyciskUruchom.Enabled = False
    listaFunkcji.AddItem "Funkcja1"
    listaFunkcji.AddItem "Funkcja2"
 
End Sub
 
Private Sub listaFunkcji_Click()
    przyciskUruchom.Enabled = True
End Sub

to znaczy, że aby przetestować taki kod trzeba: po pierwsze trzeba utworzyć formularz, po drugie umieścić na nim pole listy i przycisk a po trzecie odpowiednio je ponazywać (właściwość Name kontrolki). Efektem powyższych procedur jest początkowe wyłączenie przycisku i załadowanie pola listy. Następnie gdy użytkownik kliknie coś na liście, przycisk zostanie włączony.

Tworzenie i użycie własnej zmiennej obiektowej typu Excel.Range

Opublikowany przez
Odpowiedz

Przykład na tworzenie własnej zmiennej typu Range i posługiwanie się właściwościami obiektu Range, typu Range:

  1. CurrentRegion
  2. Rows(W)
  3. Columns(K)
  4. Cells(W,K)
Sub WlasnaZmiennaRange()
 
    Dim Zakres As Range
    Dim LW As Long, LK As Long
 
    'sprawdzenie, czy aktywna komórka znajduje się
    'w zakresie danych, przy pomocy własnej funkcji logicznej
    If fnBrakZakresu Then Exit Sub
 
    'ustawienie referencji do obiektu
    'na podstawie właściwości "Bieżący obszar" aktywnej komórki
    Set Zakres = ActiveCell.CurrentRegion
 
    'kolorowanie zakresu poprzez własną zmienną
    Zakres.Interior.ColorIndex = 35
 
    'odczyt liczby wierszy i kolumn zakresu
    LW = Zakres.Rows.Count
    LK = Zakres.Columns.Count
 
    'wyświetlenie wartości zmiennych w oknie debuggera
    Debug.Print "lw: " & LW
    Debug.Print "lk: " & LK
 
    'kolorowanie skrajnych wierszy
    Zakres.Rows(1).Interior.ColorIndex = 34
    Zakres.Rows(LW).Interior.ColorIndex = 34
 
    'i kolumn
    Zakres.Columns(1).Interior.ColorIndex = 34
    Zakres.Columns(LK).Interior.ColorIndex = 34
 
    'kolorowanie narożników zakresu
    Zakres.Cells(1, 1).Interior.ColorIndex = 36
    Zakres.Cells(1, LK).Interior.ColorIndex = 36
    Zakres.Cells(LW, 1).Interior.ColorIndex = 36
    Zakres.Cells(LW, LK).Interior.ColorIndex = 36
 
End Sub

Na koniec funkcja logiczna, z której korzysta powyższa procedura:

Function fnBrakZakresu() As Boolean
    If Len(ActiveCell) = 0 Then
        MsgBox "Ustaw się w niepustej komórce zakresu danych!"
        fnBrakZakresu = True
    End If
End Function