Excel VBA — kurs od podstaw z 25 praktycznymi makrami

Excel VBA — czym jest i dlaczego warto uczyć się go w 2026 roku?

Excel VBA (Visual Basic for Applications) to wbudowany język programowania Microsoftu, który pozwala automatyzować powtarzalne zadania, tworzyć własne funkcje i budować zaawansowane rozwiązania bezpośrednio w arkuszach kalkulacyjnych. Jeśli codziennie ręcznie kopiujesz dane, piszesz te same raporty, formatujesz tabele czy wysyłasz maile z Excela — ten kurs excel vba od podstaw zmieni Twój sposób pracy raz na zawsze. W jednym artykule znajdziesz kompletne wprowadzenie: od konfiguracji środowiska, przez typy danych i pętle, aż po 25 gotowych makr excel z pełnym, skomentowanym po polsku kodem, który możesz skopiować i uruchomić natychmiast.

W tym przewodniku otrzymasz: krok po kroku konfigurację edytora VBE (Visual Basic Editor), tabelę wszystkich typów danych VBA, tabelę ustawień bezpieczeństwa makr, omówienie pętli i obsługi błędów oraz — co najważniejsze — 25 działających makr podzielonych na kategorie: formatowanie, zarządzanie plikami, raporty, tabele przestawne, czyszczenie danych i wysyłka przez Outlook. Każde makro zawiera polskie komentarze wyjaśniające każdą linię kodu.

Zanim przejdziesz dalej: makra VBA dostępne są w desktopowej wersji Excela wchodzącej w skład pakietów Office, a nie w Excelu uruchamianym wyłącznie w przeglądarce. Jeśli korzystasz ze starszej wersji, rozważ przejście na Microsoft Office 2024 Professional Plus lub Microsoft Office 2024 Standard. Jeżeli pracujesz w modelu subskrypcyjnym, sprawdź też Microsoft 365 z aplikacjami klasycznymi pakietu Office.

Dlaczego Excel VBA wciąż ma sens w 2026 roku?

Pojawiają się głosy, że Python czy Office Scripts zastąpią VBA. Prawda jest prostsza: Excel VBA dla początkujących to wciąż najszybsza ścieżka do automatyzacji pracy biurowej w środowiskach korporacyjnych. Dziesiątki tysięcy firm w Polsce opierają swoje procesy na rozwiązaniach VBA pisanych przez lata. Umiejętność ich utrzymania i rozwijania to jedna z najbardziej pożądanych kompetencji analityków finansowych, pracowników działów HR, logistyki i controllingu.

Według oficjalnej dokumentacji Microsoft Learn dostępnej pod adresem learn.microsoft.com/pl-pl/office/vba/api/overview/excel — VBA dla Excela daje dostęp do ponad 900 obiektów, właściwości i metod umożliwiających pełną kontrolę nad arkuszem.

Jak uruchomić edytor VBA w Excel 2024 — konfiguracja krok po kroku

Bezpieczeństwo makr — ustawienia Centrum Zaufania

Przed uruchamianiem makr musisz skonfigurować ustawienia bezpieczeństwa. Znajdziesz je w Plik → Opcje → Centrum zaufania → Ustawienia Centrum zaufania → Ustawienia makr. Microsoft opisuje zmianę ustawień makr w Excelu w oficjalnej pomocy Zmienianie ustawień zabezpieczeń makr w programie Excel oraz ostrzega, aby włączać makra tylko w plikach, których działanie i pochodzenie rozumiesz. Poniższa tabela wyjaśnia różnice między dostępnymi poziomami:

Zalecenie praktyczne: korzystaj z ustawienia domyślnego (z powiadomieniem) i klikaj „Włącz zawartość" tylko w plikach, których pochodzenie znasz i którym ufasz. Nigdy nie włączaj makr w plikach przysłanych e-mailem przez nieznanych nadawców.

Typy danych VBA — kompletna tabela z przykładami

Deklarowanie zmiennych z właściwym typem danych to jeden z najważniejszych nawyków dobrego programisty VBA. Szczegółowe omówienie wszystkich typów znajdziesz w oficjalnej dokumentacji Microsoft Learn: Data Type Summary (learn.microsoft.com).

Podstawy składni VBA — zmienne, pętle i obsługa błędów

Ta część kursu opiera się na oficjalnych rozdziałach Microsoft Learn: Option Explicit statement, Declaring variables, Understanding scope and visibility, For Each...Next statement, On Error statement i Err object. W praktyce oznacza to trzy zasady: deklaruj zmienne jawnie, wybieraj typ danych świadomie i zawsze kończ makro ścieżką obsługi błędów, która przywraca ustawienia Excela.

Deklarowanie zmiennych i stałych

Option Explicit  ' Wymuszaj deklarowanie wszystkich zmiennych

' Makro 01: Podstawy deklarowania zmiennych i typów danych
Sub Makro01_TypyDanych()
    ' --- DEKLARACJE ZMIENNYCH ---
    Dim nazwaFirmy As String       ' tekst
    Dim liczbaKlientow As Long     ' liczba całkowita (preferuj Long nad Integer)
    Dim przychodMiesieczny As Double ' liczba zmiennoprzecinkowa
    Dim czyAktywny As Boolean      ' wartość logiczna (True/False)
    Dim dataKontraktu As Date      ' data
    
    ' --- PRZYPISANIE WARTOŚCI ---
    nazwaFirmy = "Kowalski Sp. z o.o."
    liczbaKlientow = 1250
    przychodMiesieczny = 98750.50
    czyAktywny = True
    dataKontraktu = #1/15/2026#  ' Daty w VBA zapisujemy w formacie #MM/DD/YYYY#
    
    ' --- STAŁE (wartości niezmienne) ---
    Const STAWKA_VAT As Double = 0.23  ' Stała dla stawki VAT 23%
    Const NAZWA_FIRMY As String = "KluczeSoft.pl"  ' Stała tekstowa
    
    ' --- WYŚWIETLENIE WYNIKU ---
    MsgBox "Firma: " & nazwaFirmy & vbCrLf & _
           "Klientów: " & liczbaKlientow & vbCrLf & _
           "Aktywna: " & czyAktywny & vbCrLf & _
           "Kontrakt od: " & Format(dataKontraktu, "dd.mm.yyyy"), _
           vbInformation, "Dane firmy"
End Sub

Instrukcje warunkowe If…Then i Select Case

' Makro 02: Instrukcje warunkowe — przykład oceny wyników sprzedaży
Sub Makro02_WarunkiIfCase()
    Dim wynikSprzedazy As Double
    Dim ocena As String
    
    ' Pobierz wartość z aktywnej komórki (zakładamy liczbę w A1)
    wynikSprzedazy = CDbl(ActiveSheet.Range("A1").Value)
    
    ' --- PRZYKŁAD 1: If...Then...ElseIf...Else ---
    If wynikSprzedazy >= 100000 Then
        ocena = "Platynowy"
    ElseIf wynikSprzedazy >= 50000 Then
        ocena = "Złoty"
    ElseIf wynikSprzedazy >= 20000 Then
        ocena = "Srebrny"
    Else
        ocena = "Standardowy"
    End If
    
    ' --- PRZYKŁAD 2: Select Case (czytelniejszy dla wielu opcji) ---
    Select Case ocena
        Case "Platynowy"
            ActiveSheet.Range("B1").Interior.Color = RGB(200, 200, 255) ' jasnoniebieski
        Case "Złoty"
            ActiveSheet.Range("B1").Interior.Color = RGB(255, 215, 0)   ' złoty
        Case "Srebrny"
            ActiveSheet.Range("B1").Interior.Color = RGB(192, 192, 192) ' srebrny
        Case Else
            ActiveSheet.Range("B1").Interior.Color = RGB(255, 255, 255) ' biały
    End Select
    
    ActiveSheet.Range("B1").Value = ocena  ' Wpisz ocenę do komórki B1
    MsgBox "Wynik: " & wynikSprzedazy & " PLN" & vbCrLf & "Poziom: " & ocena, vbInformation, "Ocena sprzedawcy"
End Sub

Pętle — For Next, For Each, Do While

' Makro 03: Pętle — trzy najważniejsze typy w praktyce
Sub Makro03_PetleRodzaje()
    Dim i As Long          ' licznik pętli For
    Dim ws As Worksheet    ' zmienna arkusza dla For Each
    Dim wynik As Long      ' akumulator
    
    ' --- PĘTLA 1: For...Next — klasyczna pętla z licznikiem ---
    ' Wpisuje liczby 1-10 do kolumny A arkusza "Arkusz1"
    For i = 1 To 10
        Sheets("Arkusz1").Cells(i, 1).Value = i     ' kolumna A, wiersz i
        Sheets("Arkusz1").Cells(i, 2).Value = i ^ 2  ' kolumna B, kwadrat liczby
    Next i
    
    ' --- PĘTLA 2: For Each...Next — iteracja po kolekcji obiektów ---
    ' Wypisuje nazwy wszystkich arkuszy do okna Immediate (Ctrl+G w VBE)
    For Each ws In ThisWorkbook.Worksheets
        Debug.Print "Arkusz: " & ws.Name  ' Debug.Print = wydruk w oknie Immediate
    Next ws
    
    ' --- PĘTLA 3: Do While...Loop — pętla warunkowa ---
    ' Sumuje wartości w kolumnie C dopóki komórka nie jest pusta
    i = 1      ' zaczynamy od wiersza 1
    wynik = 0  ' inicjalizujemy sumę
    
    Do While Sheets("Arkusz1").Cells(i, 3).Value <> ""
        wynik = wynik + CLng(Sheets("Arkusz1").Cells(i, 3).Value)
        i = i + 1  ' przejdź do kolejnego wiersza
    Loop
    
    MsgBox "Suma wartości w kolumnie C: " & wynik, vbInformation, "Wynik sumowania"
End Sub

Obsługa błędów — On Error GoTo

' Makro 04: Profesjonalna obsługa błędów w VBA
Sub Makro04_ObslugaBledow()
    Dim wynik As Double
    Dim dzielnik As Double
    
    ' Włącz obsługę błędów — przekieruj do etykiety "UchwycBlad"
    On Error GoTo UchwycBlad
    
    dzielnik = CDbl(InputBox("Podaj dzielnik (wpisz 0, aby zobaczyć obsługę błędu):", "Test"))
    
    ' Ta linia wywoła błąd "Division by zero" jeśli dzielnik = 0
    wynik = 100 / dzielnik
    
    MsgBox "Wynik: 100 / " & dzielnik & " = " & wynik, vbInformation, "Wynik"
    
    ' Instrukcja Exit Sub kończy normalny przepływ — pomija blok błędu
    Exit Sub

UchwycBlad:
    ' Obsługa błędu — Err.Number to kod błędu, Err.Description to opis
    Select Case Err.Number
        Case 11   ' Division by zero
            MsgBox "Błąd: Nie można dzielić przez zero!" & vbCrLf & _
                   "Kod błędu: " & Err.Number, vbCritical, "Błąd matematyczny"
        Case 13   ' Type mismatch
            MsgBox "Błąd: Wpisano nieprawidłowy typ danych (oczekiwano liczby)." & vbCrLf & _
                   "Kod błędu: " & Err.Number, vbCritical, "Błąd typu"
        Case Else
            MsgBox "Nieoczekiwany błąd: " & Err.Description & vbCrLf & _
                   "Kod: " & Err.Number, vbCritical, "Błąd VBA"
    End Select
    
    ' Wznów wykonanie od następnej linii po tej, która spowodowała błąd
    Resume Next
End Sub

25 praktycznych makr Excel — gotowy kod do użycia od zaraz

Kategoria 1: Formatowanie i estetyka arkuszy

' Makro 05: Automatyczne dopasowanie szerokości kolumn i wysokości wierszy
Sub Makro05_DopasujKolumnyWiersze()
    Dim ws As Worksheet
    
    ' Wyłącz odświeżanie ekranu — kod wykona się wielokrotnie szybciej
    Application.ScreenUpdating = False
    
    ' Iteruj po wszystkich arkuszach w tym skoroszycie
    For Each ws In ThisWorkbook.Worksheets
        ws.Cells.EntireColumn.AutoFit  ' Dopasuj szerokość wszystkich kolumn
        ws.Cells.EntireRow.AutoFit     ' Dopasuj wysokość wszystkich wierszy
    Next ws
    
    ' Przywróć odświeżanie ekranu
    Application.ScreenUpdating = True
    
    MsgBox "Dopasowano kolumny i wiersze we wszystkich " & _
           ThisWorkbook.Worksheets.Count & " arkuszach.", vbInformation, "Gotowe"
End Sub

' Makro 06: Dynamiczne formatowanie warunkowe wierszy na podstawie wartości w kolumnie
Sub Makro06_FormatowanieWarunkowe()
    Dim ws As Worksheet
    Dim lastRow As Long    ' ostatni wiersz z danymi
    Dim i As Long          ' licznik wierszy
    Dim statusKomorki As String
    
    Application.ScreenUpdating = False  ' Wyłącz ekran dla szybkości
    
    Set ws = ActiveSheet  ' Pracuj na aktywnym arkuszu
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row  ' Znajdź ostatni wiersz w kolumnie A
    
    ' Iteruj po wierszach od 2 (pomijając nagłówek) do ostatniego wiersza
    For i = 2 To lastRow
        statusKomorki = ws.Cells(i, 3).Value  ' Odczytaj status z kolumny C
        
        Select Case statusKomorki
            Case "Opłacone"
                ' Zielone tło dla opłaconych faktur
                ws.Rows(i).Interior.Color = RGB(198, 239, 206)
                ws.Rows(i).Font.Color = RGB(0, 97, 0)
            Case "Oczekuje"
                ' Żółte tło dla faktur oczekujących
                ws.Rows(i).Interior.Color = RGB(255, 235, 156)
                ws.Rows(i).Font.Color = RGB(156, 87, 0)
            Case "Przeterminowane"
                ' Czerwone tło dla przeterminowanych
                ws.Rows(i).Interior.Color = RGB(255, 199, 206)
                ws.Rows(i).Font.Color = RGB(156, 0, 6)
            Case Else
                ' Brak koloru — biały
                ws.Rows(i).Interior.ColorIndex = xlNone
                ws.Rows(i).Font.ColorIndex = xlAutomatic
        End Select
    Next i
    
    Application.ScreenUpdating = True  ' Przywróć ekran
    MsgBox "Formatowanie zastosowane dla " & (lastRow - 1) & " wierszy.", vbInformation, "Gotowe"
End Sub

' Makro 07: Podświetlanie duplikatów w wybranej kolumnie
Sub Makro07_PodswietlDuplikaty()
    Dim zakres As Range     ' zakres do sprawdzenia
    Dim komorka As Range    ' pojedyncza komórka
    Dim slownik As Object   ' słownik do liczenia wystąpień
    Dim klucz As String
    
    ' Utwórz obiekt słownika (Scripting.Dictionary) do zliczania wartości
    Set slownik = CreateObject("Scripting.Dictionary")
    slownik.CompareMode = 1  ' Porównuj bez uwzględnienia wielkości liter
    
    ' Pobierz zaznaczony zakres od użytkownika lub użyj kolumny A
    If TypeName(Selection) = "Range" And Selection.Cells.Count > 1 Then
        Set zakres = Selection
    Else
        ' Domyślnie: cała kolumna A z danymi na aktywnym arkuszu
        Set zakres = ActiveSheet.Range("A1:A" & ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row)
    End If
    
    ' PRZEJŚCIE 1: Zlicz wystąpienia każdej wartości
    For Each komorka In zakres
        klucz = CStr(komorka.Value)
        If klucz <> "" Then  ' Pomiń puste komórki
            If slownik.Exists(klucz) Then
                slownik(klucz) = slownik(klucz) + 1  ' Zwiększ licznik
            Else
                slownik.Add klucz, 1  ' Dodaj nowy klucz
            End If
        End If
    Next komorka
    
    ' PRZEJŚCIE 2: Pokoloruj duplikaty
    For Each komorka In zakres
        klucz = CStr(komorka.Value)
        If klucz <> "" And slownik.Exists(klucz) Then
            If slownik(klucz) > 1 Then
                komorka.Interior.Color = RGB(255, 153, 51)  ' Pomarańczowe tło dla duplikatów
            End If
        End If
    Next komorka
    
    MsgBox "Duplikaty podświetlone.", vbInformation, "Gotowe"
End Sub

Kategoria 2: Zarządzanie danymi i ich czyszczenie

' Makro 08: Usuwanie pustych wierszy z aktywnego arkusza
Sub Makro08_UsunPusteWiersze()
    Dim lastRow As Long  ' ostatni wiersz z danymi
    Dim i As Long        ' licznik — iterujemy OD DÓŁ żeby nie pominąć wierszy
    Dim licznikUsunietych As Long
    
    Application.ScreenUpdating = False  ' Wyłącz ekran dla szybkości
    
    lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    licznikUsunietych = 0
    
    ' WAŻNE: iteruj od ostatniego wiersza w górę!
    ' Jeśli idziesz od góry i usuniesz wiersz, numeracja się przesuwa i pomijasz wiersze.
    For i = lastRow To 1 Step -1
        ' Sprawdź, czy cały wiersz jest pusty (CountA liczy niepuste komórki)
        If Application.WorksheetFunction.CountA(ActiveSheet.Rows(i)) = 0 Then
            ActiveSheet.Rows(i).Delete  ' Usuń pusty wiersz
            licznikUsunietych = licznikUsunietych + 1
        End If
    Next i
    
    Application.ScreenUpdating = True  ' Przywróć ekran
    MsgBox "Usunięto " & licznikUsunietych & " pustych wierszy.", vbInformation, "Gotowe"
End Sub

' Makro 09: Czyszczenie danych — usuwanie zbędnych spacji i znaków specjalnych
Sub Makro09_CzyscDane()
    Dim ws As Worksheet
    Dim zakres As Range
    Dim komorka As Range
    Dim wartoscOryg As String
    Dim wartoscPo As String
    Dim licznikZmian As Long
    
    Application.ScreenUpdating = False
    
    Set ws = ActiveSheet
    ' Sprawdź, co użytkownik zaznaczył — jeśli nic, weź UsedRange (cały obszar danych)
    If Selection.Cells.Count = 1 Then
        Set zakres = ws.UsedRange
    Else
        Set zakres = Selection
    End If
    
    licznikZmian = 0
    
    For Each komorka In zakres
        ' Przetwarzaj tylko komórki z tekstem (nie formuły, nie liczby)
        If komorka.HasFormula = False And VarType(komorka.Value) = vbString Then
            wartoscOryg = komorka.Value
            
            ' TRIM: usuwa spacje na początku i końcu oraz wielokrotne spacje wewnątrz
            ' CLEAN: usuwa niedrukowane znaki (np. znaki nowej linii)
            wartoscPo = Application.WorksheetFunction.Trim( _
                        Application.WorksheetFunction.Clean(wartoscOryg))
            
            ' Zapisz zmienioną wartość tylko jeśli faktycznie jest różnica
            If wartoscOryg <> wartoscPo Then
                komorka.Value = wartoscPo
                licznikZmian = licznikZmian + 1
            End If
        End If
    Next komorka
    
    Application.ScreenUpdating = True
    MsgBox "Oczyszczono " & licznikZmian & " komórek ze zbędnych spacji i znaków.", _
           vbInformation, "Czyszczenie zakończone"
End Sub

' Makro 10: Konwersja formuł na wartości (zamrożenie wyników obliczeń)
Sub Makro10_FormulaNaWartosc()
    Dim zakres As Range
    
    ' Konwertuj tylko zaznaczony zakres lub cały UsedRange
    If Selection.Cells.Count > 1 Then
        Set zakres = Selection
    Else
        Set zakres = ActiveSheet.UsedRange
    End If
    
    ' Kopiuj-wklej specjalnie: tylko wartości (usuwa formuły, zostawia wyniki)
    zakres.Copy
    zakres.PasteSpecial Paste:=xlPasteValues  ' xlPasteValues = wklej tylko wartości
    
    Application.CutCopyMode = False  ' Usuń migającą ramkę kopiowania
    
    MsgBox "Formuły zamienione na wartości w zakresie " & zakres.Address, _
           vbInformation, "Konwersja zakończona"
End Sub

Kategoria 3: Zarządzanie arkuszami i plikami

' Makro 11: Tworzenie spisu treści z hiperłączami do wszystkich arkuszy
Sub Makro11_SpisTresci()
    Dim wsSpis As Worksheet     ' arkusz ze spisem treści
    Dim ws As Worksheet         ' iterowany arkusz
    Dim i As Long               ' licznik wierszy
    Const NAZWA_SPISU As String = "Spis Treści"
    
    Application.ScreenUpdating = False
    
    ' Usuń stary arkusz ze spisem jeśli istnieje
    On Error Resume Next  ' Ignoruj błąd jeśli arkusz nie istnieje
    Application.DisplayAlerts = False  ' Nie pytaj o potwierdzenie usunięcia
    ThisWorkbook.Sheets(NAZWA_SPISU).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0  ' Wznów normalną obsługę błędów
    
    ' Dodaj nowy arkusz spisu na pierwszą pozycję
    Set wsSpis = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))
    wsSpis.Name = NAZWA_SPISU
    
    ' Nagłówek spisu treści
    With wsSpis.Range("A1")
        .Value = "Spis treści — " & ThisWorkbook.Name
        .Font.Bold = True
        .Font.Size = 14
    End With
    wsSpis.Range("A2").Value = "Kliknij nazwę arkusza, aby do niego przejść:"
    
    ' Dodaj hiperłącza do każdego arkusza (pomijając sam spis)
    i = 4  ' Zacznij od wiersza 4 (2 wiersze na nagłówek + 1 pusty)
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> NAZWA_SPISU Then
            ' Dodaj hiperłącze: kliknięcie przenosi do arkusza ws, komórki A1
            wsSpis.Hyperlinks.Add _
                Anchor:=wsSpis.Cells(i, 1), _
                Address:="", _
                SubAddress:="'" & ws.Name & "'!A1", _
                TextToDisplay:=ws.Name
            i = i + 1
        End If
    Next ws
    
    wsSpis.Columns("A").AutoFit  ' Dopasuj szerokość kolumny
    Application.ScreenUpdating = True
    MsgBox "Spis treści gotowy! Dodano " & (i - 4) & " hiperłączy.", vbInformation, "Gotowe"
End Sub

' Makro 12: Ochrona wszystkich arkuszy hasłem jednocześnie
Sub Makro12_ChronWszystkieArkusze()
    Dim ws As Worksheet
    Dim haslo As String
    
    ' Poproś o hasło (InputBox zwraca pusty string jeśli kliknięto Anuluj)
    haslo = InputBox("Podaj hasło do ochrony wszystkich arkuszy:" & vbCrLf & _
                     "(Uwaga: zapamiętaj hasło! Bez niego nie odblokujesz arkuszy)", _
                     "Ustaw hasło ochrony", "")
    
    If haslo = "" Then
        MsgBox "Anulowano. Żaden arkusz nie został zabezpieczony.", vbInformation, "Anulowano"
        Exit Sub  ' Wyjdź z makra
    End If
    
    ' Chroń każdy arkusz tym samym hasłem.
    For Each ws In ThisWorkbook.Worksheets
        ws.Protect Password:=haslo, _
                    DrawingObjects:=True, _
                    Contents:=True, _
                    Scenarios:=True
    Next ws
    
    MsgBox "Wszystkie " & ThisWorkbook.Worksheets.Count & _
           " arkusze zostały zabezpieczone hasłem.", vbInformation, "Ochrona włączona"
End Sub

' Makro 13: Zdejmowanie ochrony ze wszystkich arkuszy jednocześnie
Sub Makro13_ZdejmijOchroneWszystkich()
    Dim ws As Worksheet
    Dim haslo As String
    Dim bladHasla As Boolean
    
    haslo = InputBox("Podaj hasło, aby odblokować wszystkie arkusze:", "Zdejmij ochronę", "")
    
    If haslo = "" Then
        MsgBox "Anulowano.", vbInformation, "Anulowano"
        Exit Sub
    End If
    
    bladHasla = False
    
    ' Próbuj odblokować każdy arkusz — obsłuż błąd jeśli hasło jest złe
    For Each ws In ThisWorkbook.Worksheets
        On Error Resume Next  ' Ignoruj błąd złego hasła — złapiemy go ręcznie
        ws.Unprotect Password:=haslo
        If Err.Number <> 0 Then  ' Błąd = złe hasło
            bladHasla = True
            Err.Clear
        End If
        On Error GoTo 0  ' Wróć do normalnej obsługi
    Next ws
    
    If bladHasla Then
        MsgBox "Błąd: Hasło nieprawidłowe dla jednego lub więcej arkuszy.", vbCritical, "Błąd hasła"
    Else
        MsgBox "Ochrona zdjęta ze wszystkich arkuszy.", vbInformation, "Gotowe"
    End If
End Sub

' Makro 14: Zapisz aktywny arkusz jako PDF z datą w nazwie pliku
Sub Makro14_EksportujDoPDF()
    Dim sciezkaPDF As String      ' pełna ścieżka pliku PDF
    Dim nazwaPliku As String      ' nazwa pliku bez ścieżki
    Dim folderDocelowy As String  ' folder zapisu
    
    ' Folder docelowy: ten sam, co plik Excel lub Pulpit jeśli plik niezapisany
    If ThisWorkbook.Path <> "" Then
        folderDocelowy = ThisWorkbook.Path & "\"
    Else
        folderDocelowy = Environ("USERPROFILE") & "\Desktop\"  ' Pulpit użytkownika
    End If
    
    ' Zbuduj nazwę pliku: NazwaArkusza_RRRR-MM-DD.pdf
    nazwaPliku = ActiveSheet.Name & "_" & Format(Now(), "yyyy-mm-dd") & ".pdf"
    sciezkaPDF = folderDocelowy & nazwaPliku
    
    ' Eksportuj aktywny arkusz do PDF.
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=sciezkaPDF, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    
    MsgBox "PDF zapisany jako:" & vbCrLf & sciezkaPDF, vbInformation, "Eksport zakończony"
End Sub

' Makro 15: Łączenie (konsolidacja) danych ze wszystkich arkuszy do jednego
Sub Makro15_PolaczArkusze()
    Dim wsZbiorczy As Worksheet  ' arkusz docelowy
    Dim ws As Worksheet          ' iterowany arkusz źródłowy
    Dim lastRowSrc As Long       ' ostatni wiersz w arkuszu źródłowym
    Dim lastRowDst As Long       ' ostatni wiersz w arkuszu docelowym
    Const NAZWA_ZBIORCZEGO As String = "KONSOLIDACJA"
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual  ' Wyłącz przeliczanie — szybciej
    
    ' Usuń stary arkusz zbiorczy jeśli istnieje
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(NAZWA_ZBIORCZEGO).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    ' Dodaj nowy arkusz zbiorczy na końcu
    Set wsZbiorczy = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsZbiorczy.Name = NAZWA_ZBIORCZEGO
    
    lastRowDst = 1  ' Zacznij wklejanie od wiersza 1 arkusza zbiorczego
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> NAZWA_ZBIORCZEGO Then  ' Pomiń arkusz zbiorczy
            lastRowSrc = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            If lastRowSrc > 0 Then  ' Kopiuj tylko jeśli arkusz ma dane
                ' Skopiuj cały zakres danych (od A1 do ostatniego wiersza)
                ws.Range("A1:A" & lastRowSrc).EntireRow.Copy
                wsZbiorczy.Cells(lastRowDst, 1).PasteSpecial xlPasteValues
                lastRowDst = lastRowDst + lastRowSrc  ' Przesuń wskaźnik
            End If
        End If
    Next ws
    
    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic  ' Przywróć przeliczanie
    Application.ScreenUpdating = True
    
    MsgBox "Konsolidacja zakończona. Dane z " & (ThisWorkbook.Sheets.Count - 1) & _
           " arkuszy skopiowane do '" & NAZWA_ZBIORCZEGO & "'.", vbInformation, "Gotowe"
End Sub

Kategoria 4: Automatyzacja raportów

' Makro 16: Automatyczne wstawianie wiersza z sumami na końcu tabeli
Sub Makro16_DodajWierszSum()
    Dim ws As Worksheet
    Dim lastRow As Long   ' ostatni wiersz z danymi
    Dim lastCol As Long   ' ostatnia kolumna z danymi
    Dim j As Long         ' licznik kolumn
    
    Application.ScreenUpdating = False
    
    Set ws = ActiveSheet
    ' Znajdź ostatni wiersz i kolumnę z danymi w obszarze roboczym
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    ' Wiersz sum = jeden poniżej ostatniego wiersza danych
    Dim wierszSum As Long
    wierszSum = lastRow + 1
    
    ' Wpisz etykietę "SUMA" w pierwszej kolumnie
    ws.Cells(wierszSum, 1).Value = "SUMA"
    ws.Cells(wierszSum, 1).Font.Bold = True
    
    ' Dla każdej kolumny (od 2 do ostatniej) wstaw formułę SUMA
    For j = 2 To lastCol
        ' Sprawdź, czy kolumna zawiera liczby (nie tekst)
        If IsNumeric(ws.Cells(2, j).Value) Then
            ' Wstaw formułę sumowania od wiersza 2 do lastRow
            ws.Cells(wierszSum, j).Formula = "=SUM(" & _
                ws.Cells(2, j).Address(True, False) & ":" & _
                ws.Cells(lastRow, j).Address(True, False) & ")"
            ws.Cells(wierszSum, j).Font.Bold = True
        End If
    Next j
    
    ' Sformatuj wiersz sum — gruba górna ramka
    ws.Rows(wierszSum).Borders(xlEdgeTop).LineStyle = xlContinuous
    ws.Rows(wierszSum).Borders(xlEdgeTop).Weight = xlMedium
    
    Application.ScreenUpdating = True
    MsgBox "Wiersz sum dodany w wierszu " & wierszSum & ".", vbInformation, "Gotowe"
End Sub

' Makro 17: Rozdzielanie danych do osobnych arkuszy według wartości w kolumnie
Sub Makro17_RozdzielDane()
    Dim wsDane As Worksheet      ' arkusz źródłowy z danymi
    Dim wsDocel As Worksheet     ' arkusz docelowy dla grupy
    Dim slownik As Object        ' słownik unikalnych wartości
    Dim klucz As Variant         ' klucz słownika (nazwa grupy)
    Dim lastRow As Long          ' ostatni wiersz danych
    Dim i As Long                ' licznik wierszy
    Dim kolumnaGrup As Long      ' numer kolumny z kategoriami
    Dim wartoscKomorki As String
    Dim lastRowDocel As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set wsDane = ActiveSheet
    kolumnaGrup = 2  ' ZMIEŃ TEN NUMER: która kolumna zawiera kategorie? (B = 2, C = 3 itd.)
    lastRow = wsDane.Cells(wsDane.Rows.Count, 1).End(xlUp).Row
    
    ' Zbierz unikalne wartości z kolumny grup (pomijając nagłówek w wierszu 1)
    Set slownik = CreateObject("Scripting.Dictionary")
    For i = 2 To lastRow
        wartoscKomorki = CStr(wsDane.Cells(i, kolumnaGrup).Value)
        If wartoscKomorki <> "" And Not slownik.Exists(wartoscKomorki) Then
            slownik.Add wartoscKomorki, wartoscKomorki
        End If
    Next i
    
    ' Dla każdej unikalnej wartości — utwórz arkusz i skopiuj do niego odpowiednie wiersze
    For Each klucz In slownik.Keys
        ' Sprawdź czy arkusz o tej nazwie już istnieje
        On Error Resume Next
        Set wsDocel = ThisWorkbook.Sheets(CStr(klucz))
        On Error GoTo 0
        
        If wsDocel Is Nothing Then
            ' Utwórz nowy arkusz
            Set wsDocel = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            wsDocel.Name = Left(CStr(klucz), 31)  ' Max 31 znaków w nazwie arkusza!
            ' Skopiuj wiersz nagłówka (wiersz 1)
            wsDane.Rows(1).Copy wsDocel.Rows(1)
        End If
        
        ' Skopiuj pasujące wiersze do arkusza docelowego
        For i = 2 To lastRow
            If CStr(wsDane.Cells(i, kolumnaGrup).Value) = CStr(klucz) Then
                lastRowDocel = wsDocel.Cells(wsDocel.Rows.Count, 1).End(xlUp).Row + 1
                wsDane.Rows(i).Copy wsDocel.Rows(lastRowDocel)
            End If
        Next i
        
        Set wsDocel = Nothing  ' Wyzeruj zmienną obiektu dla następnej iteracji
    Next klucz
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Dane rozdzielone do " & slownik.Count & " arkuszy według kolumny " & kolumnaGrup & ".", _
           vbInformation, "Gotowe"
End Sub

' Makro 18: Automatyczne tworzenie tabeli przestawnej (Pivot Table)
Sub Makro18_UtworzPivot()
    Dim wsDane As Worksheet       ' arkusz ze źródłem danych
    Dim wsPivot As Worksheet      ' arkusz z tabelą przestawną
    Dim zakresDanych As String    ' adres zakresu źródłowego
    Dim pt As PivotTable          ' obiekt tabeli przestawnej
    Dim pc As PivotCache          ' pamięć podręczna tabeli
    Const NAZWA_PIVOT_SHEET As String = "Raport Pivot"
    
    Application.ScreenUpdating = False
    
    Set wsDane = ActiveSheet
    ' Pobierz zakres danych (zakładamy, że dane zaczynają się od A1)
    zakresDanych = wsDane.Name & "!" & wsDane.UsedRange.Address(True, True)
    
    ' Usuń stary arkusz pivot jeśli istnieje
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(NAZWA_PIVOT_SHEET).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    ' Dodaj arkusz dla tabeli przestawnej
    Set wsPivot = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsPivot.Name = NAZWA_PIVOT_SHEET
    
    ' Utwórz pamięć podręczną (PivotCache) — punkt danych dla tabeli
    Set pc = ThisWorkbook.PivotCaches.Create( _
        SourceType:=xlDatabase, _
        SourceData:=zakresDanych, _
        Version:=xlPivotTableVersion15)  ' xlPivotTableVersion15 = Excel 2013+
    
    ' Utwórz tabelę przestawną w arkuszu wsPivot, od komórki A3
    Set pt = pc.CreatePivotTable( _
        TableDestination:=wsPivot.Range("A3"), _
        TableName:="PivotRaport")
    
    ' Skonfiguruj pola tabeli — dostosuj nazwy kolumn do swoich danych!
    ' UWAGA: "Kategoria" i "Wartość" to przykładowe nazwy kolumn z arkusza źródłowego
    With pt
        ' Pole wierszy — grupowanie (np. handlowiec, kategoria produktu)
        On Error Resume Next  ' Pomiń błąd jeśli kolumna o tej nazwie nie istnieje
        .PivotFields("Kategoria").Orientation = xlRowField
        .PivotFields("Kategoria").Position = 1
        
        ' Pole wartości — co sumujemy?
        .AddDataField .PivotFields("Wartość"), "Suma wartości", xlSum
        On Error GoTo 0
    End With
    
    Application.ScreenUpdating = True
    MsgBox "Tabela przestawna utworzona w arkuszu '" & NAZWA_PIVOT_SHEET & "'." & vbCrLf & _
           "Dostosuj pola w zakładce 'Lista pól przestawnych'.", vbInformation, "Gotowe"
End Sub

Kategoria 5: Operacje na plikach i folderach

' Makro 19: Masowe tworzenie folderów na podstawie listy w Excelu
Sub Makro19_TworzFoldery()
    Dim folderNadrzedny As String  ' folder, w którym tworzymy podfoldery
    Dim nazwaFoldera As String     ' nazwa tworzonego podfolderu
    Dim i As Long                  ' licznik wierszy
    Dim lastRow As Long
    Dim licznikUtworzone As Long
    
    ' Poproś użytkownika o wskazanie folderu nadrzędnego
    folderNadrzedny = InputBox("Podaj pełną ścieżkę folderu nadrzędnego:" & vbCrLf & _
                               "Przykład: C:\Projekty\Klienci", _
                               "Tworzenie folderów", "C:\")
    
    If folderNadrzedny = "" Then Exit Sub
    
    ' Upewnij się, że ścieżka kończy się ukośnikiem
    If Right(folderNadrzedny, 1) <> "\" Then folderNadrzedny = folderNadrzedny & "\"
    
    ' Sprawdź czy folder nadrzędny istnieje
    If Dir(folderNadrzedny, vbDirectory) = "" Then
        MsgBox "Folder nadrzędny nie istnieje: " & folderNadrzedny, vbCritical, "Błąd"
        Exit Sub
    End If
    
    lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    licznikUtworzone = 0
    
    ' Czytaj nazwy folderów z kolumny A (od wiersza 2, pomijając nagłówek)
    For i = 2 To lastRow
        nazwaFoldera = CStr(ActiveSheet.Cells(i, 1).Value)
        
        If nazwaFoldera <> "" Then
            Dim pelnaSciezka As String
            pelnaSciezka = folderNadrzedny & nazwaFoldera
            
            ' Utwórz folder tylko jeśli jeszcze nie istnieje
            If Dir(pelnaSciezka, vbDirectory) = "" Then
                MkDir pelnaSciezka  ' VBA wbudowana funkcja tworzenia katalogu
                ActiveSheet.Cells(i, 2).Value = "Utworzono"  ' Zapisz status w kol. B
                licznikUtworzone = licznikUtworzone + 1
            Else
                ActiveSheet.Cells(i, 2).Value = "Już istnieje"  ' Folder już był
            End If
        End If
    Next i
    
    MsgBox "Utworzono " & licznikUtworzone & " nowych folderów w:" & vbCrLf & folderNadrzedny, _
           vbInformation, "Gotowe"
End Sub

' Makro 20: Pętla po wszystkich plikach Excel w folderze i zbieranie danych
Sub Makro20_PetlaPoPlikach()
    Dim folderSciezka As String    ' ścieżka do przeszukiwanego folderu
    Dim nazwaPliku As String       ' nazwa aktualnie przetwarzanego pliku
    Dim wbZewnetrzny As Workbook   ' otwierany plik Excel
    Dim wsZbior As Worksheet       ' arkusz zbiorczy wyników
    Dim wiersz As Long             ' bieżący wiersz w arkuszu zbiorczym
    
    ' Wyświetl okno wyboru folderu
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Wybierz folder z plikami Excel"
        If .Show <> -1 Then Exit Sub  ' Użytkownik anulował
        folderSciezka = .SelectedItems(1) & "\"
    End With
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False  ' Wyłącz alerty przy otwieraniu plików
    
    ' Przygotuj arkusz zbiorczy — użyj aktywnego arkusza
    Set wsZbior = ActiveSheet
    ' Dodaj nagłówki
    wsZbior.Range("A1:C1").Value = Array("Nazwa pliku", "Arkusze", "Wartość A1 (Arkusz1)")
    wsZbior.Range("A1:C1").Font.Bold = True
    wiersz = 2  ' zacznij wpisywać od wiersza 2
    
    ' Wyszukaj wszystkie pliki .xlsx i .xlsm w folderze
    nazwaPliku = Dir(folderSciezka & "*.xls*")  ' Gwiazdka pasuje do xlsx, xlsm, xlsb
    
    Do While nazwaPliku <> ""  ' Pętla dopóki Dir() zwraca nazwy
        On Error Resume Next  ' Obsłuż błędy otwierania
        ' Otwórz plik zewnętrzny bez makr, bez aktualizacji linków, tylko do odczytu
        Set wbZewnetrzny = Workbooks.Open( _
            Filename:=folderSciezka & nazwaPliku, _
            UpdateLinks:=False, _
            ReadOnly:=True, _
            EnableMacros:=False)
        
        If Err.Number = 0 Then  ' Jeśli otwarcie się powiodło
            ' Zbierz dane: nazwa pliku, liczba arkuszy, wartość komórki A1 z pierwszego arkusza
            wsZbior.Cells(wiersz, 1).Value = nazwaPliku
            wsZbior.Cells(wiersz, 2).Value = wbZewnetrzny.Sheets.Count
            wsZbior.Cells(wiersz, 3).Value = wbZewnetrzny.Sheets(1).Range("A1").Value
            wiersz = wiersz + 1
            
            wbZewnetrzny.Close SaveChanges:=False  ' Zamknij bez zapisywania
        End If
        Err.Clear
        On Error GoTo 0
        
        nazwaPliku = Dir()  ' Dir() bez argumentu = następny plik w katalogu
    Loop
    
    wsZbior.Columns("A:C").AutoFit  ' Dopasuj kolumny
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Przetworzono " & (wiersz - 2) & " plików z folderu:" & vbCrLf & folderSciezka, _
           vbInformation, "Gotowe"
End Sub

' Makro 21: Importowanie danych z pliku CSV do aktywnego arkusza
Sub Makro21_ImportCSV()
    Dim sciezkaCSV As String    ' pełna ścieżka do pliku CSV
    Dim numerPliku As Integer   ' numer strumienia pliku (FreeFile)
    Dim linia As String         ' odczytana linia tekstu
    Dim kolumny() As String     ' tablica wartości po podziale linii
    Dim wiersz As Long          ' numer bieżącego wiersza w arkuszu
    Dim j As Long               ' licznik kolumn
    
    ' Okno wyboru pliku CSV
    sciezkaCSV = Application.GetOpenFilename( _
        FileFilter:="Pliki CSV (*.csv),*.csv,Pliki tekstowe (*.txt),*.txt", _
        Title:="Wybierz plik CSV do importu")
    
    If sciezkaCSV = "False" Then Exit Sub  ' Anulowano
    
    Application.ScreenUpdating = False
    
    ' Wyczyść aktywny arkusz przed importem
    ActiveSheet.Cells.ClearContents
    
    ' Otwórz plik do odczytu
    numerPliku = FreeFile()  ' FreeFile() zwraca wolny numer strumienia
    Open sciezkaCSV For Input As #numerPliku
    
    wiersz = 1  ' zacznij od wiersza 1
    
    Do While Not EOF(numerPliku)  ' EOF = End Of File
        Line Input #numerPliku, linia  ' Odczytaj jedną linię tekstu
        
        ' Podziel linię po przecinku (CSV = Comma Separated Values)
        ' UWAGA: dla polskich plików z średnikiem jako separatorem zamień "," na ";"
        kolumny = Split(linia, ",")
        
        ' Wpisz każdą kolumnę do odpowiedniej komórki w bieżącym wierszu
        For j = 0 To UBound(kolumny)  ' UBound = ostatni indeks tablicy
            ActiveSheet.Cells(wiersz, j + 1).Value = Trim(kolumny(j))  ' Trim usuwa spacje
        Next j
        
        wiersz = wiersz + 1  ' Przejdź do następnego wiersza
    Loop
    
    Close #numerPliku  ' ZAWSZE zamknij plik po pracy!
    
    ActiveSheet.Columns.AutoFit  ' Dopasuj szerokość kolumn
    Application.ScreenUpdating = True
    
    MsgBox "Zaimportowano " & (wiersz - 1) & " wierszy z pliku CSV.", vbInformation, "Import zakończony"
End Sub

Kategoria 6: Integracja z Outlook i pobieranie danych zewnętrznych

' Makro 22: Wysyłanie emaila przez Microsoft Outlook z aktywnym arkuszem jako załącznik
' WYMAGANIE: Zainstalowany i skonfigurowany Outlook w tym samym systemie co Excel
Sub Makro22_WyslijEmailOutlook()
    Dim aplikacjaOutlook As Object  ' obiekt aplikacji Outlook
    Dim email As Object             ' obiekt wiadomości MailItem
    Dim sciezkaZalacznika As String ' ścieżka do pliku PDF / Excel
    Dim adresOdbiorcy As String
    Dim tematWiadomosci As String
    Dim trescWiadomosci As String
    
    ' Sprawdź czy plik został zapisany (potrzebujemy ścieżki do tworzenia załącznika)
    If ThisWorkbook.Path = "" Then
        MsgBox "Zapisz plik przed wysłaniem. Używamy jego kopii PDF jako załącznika.", _
               vbExclamation, "Uwaga"
        Exit Sub
    End If
    
    ' Dane email — można dynamicznie pobierać z arkusza
    adresOdbiorcy = InputBox("Adres e-mail odbiorcy:", "Wyślij raport", "")
    If adresOdbiorcy = "" Then Exit Sub
    
    tematWiadomosci = "Raport: " & ActiveSheet.Name & " — " & Format(Now(), "yyyy-mm-dd")
    trescWiadomosci = "Witaj," & vbCrLf & vbCrLf & _
                      "W załączeniu przesyłam raport: " & ActiveSheet.Name & "." & vbCrLf & _
                      "Data: " & Format(Now(), "dd.mm.yyyy HH:MM") & vbCrLf & vbCrLf & _
                      "Pozdrawiam"
    
    ' Najpierw wyeksportuj arkusz do PDF (żeby mieć plik do załączenia)
    sciezkaZalacznika = ThisWorkbook.Path & "\" & ActiveSheet.Name & "_" & _
                        Format(Now(), "yyyymmdd") & ".pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sciezkaZalacznika
    
    ' Utwórz obiekt Outlook (Late Binding — działa bez referencji do biblioteki)
    Set aplikacjaOutlook = CreateObject("Outlook.Application")
    Set email = aplikacjaOutlook.CreateItem(0)  ' 0 = olMailItem (wiadomość e-mail)
    
    ' Skonfiguruj wiadomość
    With email
        .To = adresOdbiorcy
        .Subject = tematWiadomosci
        .Body = trescWiadomosci
        .Attachments.Add sciezkaZalacznika  ' Dodaj PDF jako załącznik
        .Display  ' Pokaż wiadomość w Outlooku zamiast wysyłać automatycznie
        ' Zamień .Display na .Send jeśli chcesz wysyłać bez podglądu!
    End With
    
    MsgBox "Wiadomość przygotowana w Outlooku. Sprawdź i kliknij Wyślij.", _
           vbInformation, "Email gotowy"
    
    ' Zwolnij obiekty COM
    Set email = Nothing
    Set aplikacjaOutlook = Nothing
End Sub

' Makro 23: Pobieranie aktualnego kursu walut z API NBP (JSON via XMLHTTP)
Sub Makro23_KursWalutNBP()
    Dim http As Object          ' obiekt żądania HTTP
    Dim url As String           ' URL do API NBP
    Dim odpowiedz As String     ' surowa odpowiedź JSON
    Dim kursStr As String       ' kurs jako tekst
    Dim kurs As Double          ' kurs jako liczba
    Dim waluta As String
    
    ' Pobierz kod waluty od użytkownika (np. EUR, USD, GBP, CHF)
    waluta = UCase(InputBox("Podaj kod waluty (np. EUR, USD, GBP, CHF):", _
                            "Kurs NBP", "EUR"))
    If waluta = "" Then Exit Sub
    
    ' URL API NBP: https://api.nbp.pl/api/exchangerates/rates/a/{waluta}/?format=json
    url = "https://api.nbp.pl/api/exchangerates/rates/a/" & waluta & "/?format=json"
    
    ' Utwórz obiekt XMLHTTP (Late Binding)
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    On Error GoTo BladAPI
    
    ' Wykonaj synchroniczne żądanie GET
    http.Open "GET", url, False    ' False = synchroniczne (czekaj na odpowiedź)
    http.Send                       ' Wyślij żądanie
    
    If http.Status = 200 Then  ' 200 = OK (sukces HTTP)
        odpowiedz = http.ResponseText  ' Pobierz treść odpowiedzi
        
        ' Proste wyodrębnienie kursu z JSON-a (szukamy "mid":)
        ' Bardziej zaawansowane parsowanie JSON wymaga biblioteki lub regex
        Dim pozycja As Long
        pozycja = InStr(odpowiedz, """mid"":")
        If pozycja > 0 Then
            kursStr = Mid(odpowiedz, pozycja + 7, 8)  ' Pobierz 8 znaków po "mid":
            kursStr = Left(kursStr, InStr(kursStr, "}") - 1)  ' Utnij po pierwszym }
            kursStr = Trim(Replace(kursStr, ",", "."))  ' Zamień przecinek na kropkę
            kurs = CDbl(kursStr)  ' Konwertuj na liczbę Double
            
            ' Wpisz kurs do aktywnej komórki
            ActiveCell.Value = kurs
            ActiveCell.NumberFormat = "0.0000"  ' 4 miejsca po przecinku
            
            MsgBox "Kurs " & waluta & "/PLN z NBP: " & Format(kurs, "0.0000") & " PLN" & vbCrLf & _
                   "Wpisano do komórki: " & ActiveCell.Address, vbInformation, "Kurs NBP"
        Else
            MsgBox "Nie można odczytać kursu z odpowiedzi API.", vbExclamation, "Błąd parsowania"
        End If
    Else
        MsgBox "Błąd API NBP. Kod HTTP: " & http.Status & vbCrLf & _
               "Sprawdź czy kod waluty jest poprawny: " & waluta, vbCritical, "Błąd HTTP"
    End If
    
    Set http = Nothing  ' Zwolnij obiekt
    Exit Sub

BladAPI:
    MsgBox "Błąd połączenia z API NBP." & vbCrLf & _
           "Sprawdź połączenie internetowe." & vbCrLf & _
           "Kod błędu: " & Err.Number & " — " & Err.Description, vbCritical, "Błąd połączenia"
    Set http = Nothing
End Sub

Kategoria 7: Zaawansowane narzędzia i event handling

' Makro 24: Logowanie zmian w komórkach do arkusza historii (Event Handling)
' UWAGA: To makro umieść w module ARKUSZA (nie w module ogólnym), np. kliknij prawym
' na nazwę arkusza w Project Explorer → View Code → wklej tam ten kod
Private Sub Worksheet_Change(ByVal Target As Range)
    ' Target = komórka (lub zakres), która właśnie zmieniła wartość
    
    Dim wsHistoria As Worksheet   ' arkusz z historią zmian
    Dim lastRow As Long           ' ostatni wiersz w historii
    Dim nazwaUzytkownika As String
    
    ' Ignoruj zmiany w całym arkuszu lub dla komórek w obszarze historii (pętla)
    If Target.Cells.Count > 10 Then Exit Sub  ' Zbyt duże zaznaczenie — pomiń
    
    ' Spróbuj uzyskać lub stworzyć arkusz historii
    On Error Resume Next
    Set wsHistoria = ThisWorkbook.Sheets("Historia zmian")
    On Error GoTo 0
    
    If wsHistoria Is Nothing Then
        Set wsHistoria = ThisWorkbook.Sheets.Add
        wsHistoria.Name = "Historia zmian"
        ' Nagłówki kolumn historii
        wsHistoria.Range("A1:E1").Value = Array("Data i godzina", "Użytkownik", "Arkusz", "Komórka", "Nowa wartość")
        wsHistoria.Range("A1:E1").Font.Bold = True
    End If
    
    ' Pobierz nazwę zalogowanego użytkownika Windows
    nazwaUzytkownika = Environ("USERNAME")
    
    ' Wyłącz obsługę zdarzeń żeby uniknąć nieskończonej pętli
    Application.EnableEvents = False
    
    lastRow = wsHistoria.Cells(wsHistoria.Rows.Count, "A").End(xlUp).Row + 1
    
    ' Iteruj po każdej zmienionej komórce (może być kilka naraz)
    Dim komorka As Range
    For Each komorka In Target.Cells
        wsHistoria.Cells(lastRow, 1).Value = Now()                 ' Znacznik czasu
        wsHistoria.Cells(lastRow, 1).NumberFormat = "dd.mm.yyyy hh:mm:ss"
        wsHistoria.Cells(lastRow, 2).Value = nazwaUzytkownika      ' Użytkownik
        wsHistoria.Cells(lastRow, 3).Value = Me.Name               ' Nazwa arkusza (Me = bieżący arkusz)
        wsHistoria.Cells(lastRow, 4).Value = komorka.Address(False, False)  ' Adres komórki np. B5
        wsHistoria.Cells(lastRow, 5).Value = komorka.Value         ' Nowa wartość
        lastRow = lastRow + 1
    Next komorka
    
    ' Przywróć obsługę zdarzeń
    Application.EnableEvents = True
End Sub

' Makro 25: Przycisk "Resetuj wszystkie filtry" — jednym kliknięciem przywróć pełny widok
Sub Makro25_ResetujFiltry()
    Dim ws As Worksheet
    Dim lt As ListObject  ' obiekt tabeli Excel (Table/ListObject)
    
    Application.ScreenUpdating = False
    
    Set ws = ActiveSheet
    
    ' METODA 1: Usuń AutoFilter jeśli jest aktywny na zwykłym zakresie
    If ws.AutoFilterMode Then
        ' ShowAllData wyłącza filtrowanie ale zostawia strzałki
        If ws.FilterMode Then ws.ShowAllData
    End If
    
    ' METODA 2: Wyczyść filtry we wszystkich tabelach Excel (ListObjects) na arkuszu
    For Each lt In ws.ListObjects
        If Not lt.AutoFilter Is Nothing Then
            lt.AutoFilter.ShowAllData  ' Pokaż wszystkie wiersze tabeli
        End If
    Next lt
    
    ' METODA 3: Usuń filtr grupowania (jeśli dane były pogrupowane)
    On Error Resume Next
    ws.Cells.Rows.Hidden = False   ' Odkryj wszystkie ukryte wiersze
    ws.Cells.Columns.Hidden = False ' Odkryj wszystkie ukryte kolumny
    On Error GoTo 0
    
    Application.ScreenUpdating = True
    
    ' Powiadom użytkownika
    MsgBox "Wszystkie filtry zostały zresetowane. Widoczne są wszystkie dane.", _
           vbInformation, "Filtry wyczyszczone"
End Sub

Podsumowanie — od czego zacząć naukę Excel VBA?

Masz teraz w rękach kompletny excel vba tutorial po polsku — od konfiguracji środowiska przez typy danych, instrukcje warunkowe, pętle i obsługę błędów, aż po 25 gotowych makr z pełnym, skomentowanym kodem.

Pamiętaj: VBA działa wyłącznie w desktopowej wersji Excela. Jeśli korzystasz ze starego pakietu biurowego, czas na upgrade. Microsoft Office 2024 Professional Plus i Office 2024 Standard dostępne są w konkurencyjnych cenach w sklepie kluczesoft.pl — zarówno jako licencje wieczyste, jak i w ramach subskrypcji Microsoft 365. Inwestycja w licencję zwróci się już po kilku godzinach zaoszczędzonych dzięki automatyzacji VBA.