Czyli tworzenie wielu PDF-ów z jednej formatki

Podobny temat kiedyś już poruszałam na blogu, natomiast chodziło o stworzenie oddzielnych arkuszy dla pracowników, których informujemy o podwyżce. Tym razem też będziemy informować pracowników o podwyżce, natomiast dla każdego wygenerujemy oddzielny PDF z tą informacją. O tak:

Tylko troszkę zmodyfikujemy kod, który pokazywałam tutaj. Jedziemy!

Co będzie do zmiany?

Logika poprzedniego kodu była taka, że kopiowaliśmy arkusz z formatką i podstawialiśmy do niego dane kolejnej osoby. Robiliśmy to (pętlą) tyle razy, ile było osób na liście w arkuszu Dane. Oto formatka z listą osób, dla przypomnienia:

Dane do podstawienia do formatki

Teraz, będziemy oczywiście wstawiać dane odpowiednich osób, natomiast zamiast kopiowania arkuszy – stworzymy PDF. A dokładniej: będziemy eksportować arkusz Excela do PDF (już kilka razy pisałam o tym na blogu – listę artykułów znajdziesz na dole tego wpisu).

W tym celu dokonamy kilku zmian w poprzednim kodzie.

Poprzedni kod i zmiany w nim

Poprzedni kod (umieszczony w module, tutaj znajdziesz opis jak to zrobić) wygląda następująco (dokładny jego opis znajdziesz tutaj):

Sub Korespondencja()
    Dim Zakres As Range, Czlowiek As String, Stawka As Double
    Dim ArkWniosek As Worksheet, ArkNowy As Worksheet
    Dim Licznik As Long, Wierszy As Long
    
    Application.ScreenUpdating = False
    
    Set ArkWniosek = Sheets("Wniosek")
    Set Zakres = Sheets("Dane").Range("tbOsoby")
        Wierszy = Zakres.Rows.Count
    
    For Licznik = 1 To Wierszy
        Czlowiek = Zakres.Cells(Licznik, 1).Value
        Stawka = Zakres.Cells(Licznik, 2).Value
        
        ArkWniosek.Copy After:=ArkWniosek
            Set ArkNowy = Sheets(ArkWniosek.Index + 1)
            ArkNowy.Name = Czlowiek
        
        ArkNowy.Range("F9").Value = Czlowiek
        ArkNowy.Range("F12").Value = Stawka
    Next
    
    ArkWniosek.Activate
    Application.ScreenUpdating = True
End Sub

1. Na początek dodeklarujemy zmienną Sciezka, która będzie mówiła o miejscu zapisywania naszych wynikowych PDF-ów. Przypiszemy od razu do niej wartość – będzie to dokładnie ta sama ścieżka co pliku, w którym jest makro. Te 2 linijki o tym mówią:

    Dim  Sciezka As String

    Sciezka = ThisWorkbook.Path & "\"

2. Teraz usunę fragment kopiujący arkusz i zmieniający jego nazwę.

3. Zostawię przypisanie wartości do komórek, natomiast zmienię arkusz, w którym to robię z ArkNowy na ArkWniosek, ponieważ wszystko będzie działa się w jednej formatce. Wrzucę to w konstrukcję With:

        With ArkWniosek
            .Range("F9").Value = Czlowiek
            .Range("F12").Value = Stawka
        End With

4. Teraz już czas zapisanie tego jako PDF, czy raczej eksport do PDF (poniższy kod najłatwiej wygenerować poprzez nagranie makra, które zapisze plik jako PDF):

       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Sciezka & Czlowiek & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

Zauważ, że jako nazwę pliku (filename) podałam kombinację Sciezki i Czlowieka – tak chcę nazywać utworzone pliki PDF. Pamiętaj, że wartość zmiennej Czlowiek musi być unikalna!

5. Na koniec jeszcze czyszczenie formatki:

    With ArkWniosek
        .Range("F9").ClearContents
        .Range("F12").ClearContents
    End With

6. I poinformowanie użytkownika, że wygenerowano PDF-y. Kosmetyka, ale ułatwia pracę:

       MsgBox "Stworzono PDF-y.", vbInformation

7. Cały kod wygląda tak (makro nazwałam TworzPDFy):

Sub TworzPDFy()
    Dim Zakres As Range, Czlowiek As String, Stawka As Double
    Dim ArkWniosek As Worksheet, Sciezka As String
    Dim Licznik As Long, Wierszy As Long
    
    Application.ScreenUpdating = False
    
    Set ArkWniosek = Sheets("Wniosek")
    Set Zakres = Sheets("Dane").Range("tbOsoby")
        Wierszy = Zakres.Rows.Count
    Sciezka = ThisWorkbook.Path & "\"
    
    For Licznik = 1 To Wierszy
        Czlowiek = Zakres.Cells(Licznik, 1).Value
        Stawka = Zakres.Cells(Licznik, 2).Value
        
        With ArkWniosek
            .Range("F9").Value = Czlowiek
            .Range("F12").Value = Stawka
        End With
        
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Sciezka & Czlowiek & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    Next
    
    With ArkWniosek
        .Range("F9").ClearContents
        .Range("F12").ClearContents
    End With
    
    Application.ScreenUpdating = True
    MsgBox "Stworzono PDF-y.", vbInformation
    
End Sub

To tyle. Pamiętaj koniecznie, aby plik zapisać jako plik obsługujący makra (czyli xlsm lub xlsb). I pamiętaj, aby podzielić się tym wpisem ze znajomymi – pewnie im też się przyda :)!

Załączam plik do pobrania:

MalinowyExcel_Korespondencja seryjna w Excelu oddzielne PDF dw.zip

Chcesz nauczyć się pisać makra w Excelu?

A jeśli chcesz nauczyć się pisać makra od zera – koniecznie zapisz się na listę zainteresowanych moim kursem wprowadzającym do pisania makr Excel w codziennej pracy cz. 3.! Zapis jest bezpłatny, podobnie jak cotygodniowe artykuły, które lądują prosto na Twojego maila :).

I wersja wideo:

Tutaj znajdziesz jeszcze inne wpisy o tworzeniu PDF na podstawie arkusza:

• Zawiadomienie pracowników o zmianie wynagrodzenia (tworzenie oddzielnego arkusza dla każdego pracownika)
• Zapisz plik jako PDF z dzisiejszą datą w nazwie (VBA)
• Zapisz plik jako PDF w tym samym folderze (VBA)
• Jak przenieść formatowanie do korespondencji seryjnej w Wordzie?