PDF mit VBA erstellen

[wieselchen]

Hallo,

ich möchte die PDF-Erstellung automatisieren und stehe grade auf dem Schlauch.

Das Ziel ist eine Reihe von Registerblättern, die alle mit der Zeichenfolge "GST" beginnen in ein PDF zu drucken/speichern.
Ich hab vor ein paar Jahren diesen Code gebastelt, um die Register jeweils als einzelnes PDF zu speichern und dachte, ich könne das einfach anpassen, musste aber feststellen ich bin enorm aus der Übung.

Code:

Private Sub PDF_Click()
    Dim vntFolder As Variant
    Dim wks As Worksheet
    Dim strFileName As String
   
    'Ordner für PDF-Datei auswählen
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Bitte Ordner für zu erstellende PDF-Dateien auswählen/anlegen"
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show = -1 Then
            vntFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    'Erstelle diese Register als PDF
    For Each wks In Worksheets
        If Left(wks.Name, 3) = "GST" Then
       
        With wks
            strFileName = vntFolder & "\" & Left(ThisWorkbook.Name, 10) & wks.Name & ".pdf"
           
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False
        End With
        End If
    Next wks
    MsgBox "PDF-Dateien sind erstellt"
End Sub

Hat jemand eine Idee?

Viele Grüße,
wieselchen

[Fennek]

Hallo,

das Problem ist in

vntFolder & "\" & Left(ThisWorkbook.Name, 10) & wks.Name & ".pdf"

Leicht vereinfacht geht:

Code:

strFileName = ThisWorkbook.Path & "\" & wks.Name & ".pdf"

mfg

[RPP63]

Moin!
Ich sehe im Ggs. zu Fennek kein Problem!
Der Code läuft einwandfrei durch.
Vielleicht schilderst Du mal, was der Code Deiner Meinung nach falsch macht.
Was ergibt denn ThisWorkbook.Name?

Gruß Ralf

[wieselchen]

Hi!

die Datei (Anlage 10 Entwicklung MMJJ) enthält 13 Ausgabe-Register, die mit "GST" anfangen, der Code, so wie er ist, erstellt für jedes Register ein PDF mit der Bezeichnung "die ersten zehn Zeichen des aktuellen Dateinamens (ThisWorkbook.Name, 10)"+"Name des Registers".
Als Ergebnis erhalte ich 13 PDF-Dateien mit einer Seite, dem jeweiligen Register, "Anlage 10 GST Berg",  "Anlage 10 GST Baum",  "Anlage 10 GST Stein" etc.

Was der Code machen soll:
Die 13 Register, die mit "GST" anfangen in EINE PDF-Datei mit 13 Seiten speichern. 

Optimalerweise mit dem selben Namen wie die Excel-Datei, aber wenn ich den Namen im Code anpasse auf 
vntFolder & "\" & ThisWorkbook.Name & ".pdf"
sodass die Datei als "Anlage 10 Entwicklung MMJJ" gespeichert wird, überschreibt er die Datei 13mal und das PDF enthält nur das letzte Register anstatt alle "GST"-Register.


Liebe Grüße

[schauan]

Hallöchen,

weißt Du, wie man manuell mehrere Blätter in eine pdf bekommt? Wenn ja, zeichne den Code auf und Du wirst sehen, was Du anders machen musst ...

[UweD]

Hallo



so?

Code:

Option Explicit

Private Sub PDF_Click()
    Dim vntFolder As Variant
    Dim wks As Worksheet
    Dim arrSheets() As String
    Dim count As Integer
    Dim strFileName As String
   
    count = 0
  
    'Ordner für PDF-Datei auswählen
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Bitte Ordner für zu erstellende PDF-Dateien auswählen/anlegen"
        .InitialFileName = ThisWorkbook.Path & "\"
        If .Show = -1 Then
            vntFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
   
    'Erstelle diese Register als PDF
    For Each wks In Worksheets
        ' Alle Worksheets prüfen
        If wks.Name Like "GST *" Then
            count = count + 1
            ReDim Preserve arrSheets(1 To count)
            arrSheets(count) = wks.Name
        End If
    Next wks
   
    ' Wenn keine passenden Blätter gefunden wurden
    If count = 0 Then
        MsgBox "Keine Blätter mit 'GST ' gefunden."
        Exit Sub
    End If
   
    ' Datei benennen
    strFileName = vntFolder & "\" & ThisWorkbook.Name & ".pdf"
   
    ' Blätter auswählen und exportieren
    ThisWorkbook.Sheets(arrSheets).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
    ThisWorkbook.Sheets(1).Select
    MsgBox "PDF-Datei wurde erstellt"
End Sub

LG UweD