PDF Ausdruck speichern

Forumthread: PDF Ausdruck speichern

31.03.2025 19:09:44

Joachim Baum

Mit dem folgenden Makro habe ich versucht einen PDF-Formular in ein entsprechendes Verzeichnis zu speichern und auszudrucken. Das hat auch gut funktioniert. Auch beim zweiten Versuch hat alles vorbildlich geklappt, nur beim dritten Versuch konnte das Makro nicht aktiviert werden. Es kamm auch keine Fehlermeldung. Wenn ich einen anderen Investor eingegeben habe, konnte ich das untere Makro wieder, allerdings nur zweimal aktiieren.

Sub PDF_drucken_Gesamt()

Dim Bez_02 As String
Dim Bez_03 As String
Dim Bez_05 As String
Dim Bez_06 As String
Dim Bez_08 As String

Bez_02 = Worksheets("Grundlagen").Range("AE6").Value 'Projektname
Bez_03 = Worksheets("Grundlagen").Range("AE5").Value 'Berechnungen
Bez_05 = Worksheets("Grundlagen").Range("AF4").Value 'PDF
Bez_06 = Worksheets("Grundlagen").Range("AE19").Value 'Investoren
Bez_08 = Worksheets("Grundlagen").Range("AF19").Value 'Investoren Namen

If Worksheets("Grundlagen").Range("AF24").Value = 1 Then
MsgBox "Sie haben weder einen Investor noch ein Projekt eingegeben !"
Exit Sub
End If
If Worksheets("Grundlagen").Range("AF24").Value = 2 Then
MsgBox "Sie haben kein Projekt eingegeben !"
Exit Sub
End If
If Worksheets("Grundlagen").Range("AF24").Value = 3 Then GoTo Anfang:
If Worksheets("Grundlagen").Range("AF24").Value = 4 Then GoTo Investoren:

Anfang:
If Dir$("C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\", vbDirectory) = "" Then
VBA.MkDir "C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\"
Else: GoTo Abfrage1:
Exit Sub
End If

Abfrage1:
If Dir$("C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_03 & "\", vbDirectory) = "" Then
VBA.MkDir "C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_03 & "\"
Else: GoTo Abfrage2:
Exit Sub
End If

Abfrage2:
If Dir$("C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_03 & "\" & Bez_05 & "\", vbDirectory) = "" Then
VBA.MkDir "C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_03 & "\" & Bez_05 & "\"

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, From:=1, To:=6, Filename:= _
"C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_03 & "\" & Bez_05 & "\" & ActiveSheet.Range("BB7"), _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

Exit Sub
End If

Investoren:

If Dir$("C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\", vbDirectory) = "" Then
VBA.MkDir "C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\"
Else: GoTo Abfrage4:
Exit Sub
End If

Abfrage4:
If Dir$("C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_06 & "\", vbDirectory) = "" Then
VBA.MkDir "C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_06 & "\"
Else: GoTo Abfrage5:
Exit Sub
End If

Abfrage5:
If Dir$("C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_06 & "\" & Bez_08 & "\", vbDirectory) = "" Then
VBA.MkDir "C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_06 & "\" & Bez_08 & "\"
Else: GoTo Abfrage6:
Exit Sub
End If

Abfrage6:
If Dir$("C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_06 & "\" & Bez_08 & "\" & Bez_05 & "\", vbDirectory) = "" Then
VBA.MkDir "C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_06 & "\" & Bez_08 & "\" & Bez_05 & "\"

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, From:=1, To:=6, Filename:= _
"C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\" & Bez_02 & "\" & Bez_06 & "\" & Bez_08 & "\" & Bez_05 & "\" & ActiveSheet.Range("BC2"), _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

End If

End Sub

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: PDF Ausdruck speichern

31.03.2025 21:51:50

ralf_b
AW: PDF Ausdruck speichern

31.03.2025 22:39:29

Yal

AW: PDF Ausdruck speichern

31.03.2025 21:51:50

ralf_b

Versuch mal den Code,

Sub PDF_drucken_Gesamt()

    

    Dim Bez_02$, Bez_03$, Bez_05$, Bez_06$, Bez_08$

    Dim sourcedir$, sDateiname$

    

    sourcedir = "C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden\"

    

    With Worksheets("Grundlagen")

        Bez_02 = .Range("AE6").Value              'Projektname

        Bez_03 = .Range("AE5").Value              'Berechnungen

        Bez_05 = .Range("AF4").Value              'PDF

        Bez_06 = .Range("AE19").Value             'Investoren

        Bez_08 = .Range("AF19").Value             'Investoren Namen

        

        

        If Bez_02 = "" Or Bez_03 = "" Or Bez_05 = "" Or Bez_06 = "" Or Bez_08 = "" Then

            MsgBox "Daten fehlen"

        Else

            

            Select Case .Range("AF24").Value

            Case 1: MsgBox ("Sie haben weder einen Investor noch ein Projekt eingegeben !")

            Case 2: MsgBox ("Sie haben kein Projekt eingegeben !")

            Case 3

                sourcedir = sourcedir & Bez_02 & "\" & Bez_03 & "\" & Bez_05 & "\"

                sDateiname = ActiveSheet.Range("BB7")

            Case 4

                sourcedir = sourcedir & Bez_02 & "\" & Bez_06 & "\" & Bez_08 & "\" & Bez_05 & "\"

                sDateiname = ActiveSheet.Range("BC2")

                               

            End Select

        End If

        

    End With

    

    If ErstellePfad(sourcedir) And sDateiname > "" Then

        

         If Dir(sourcedir & sDateiname) = "" Then

              ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _

                                                From:=1, To:=6, _

                                                Filename:=sourcedir & sDateiname, _

                                                Quality:=xlQualityStandard, _

                                                IncludeDocProperties:=True, _

                                                IgnorePrintAreas:=False, _

                                                OpenAfterPublish:=True

        Else

            MsgBox "Datei existiert schon"

        End If

    Else

        MsgBox "Pfaderstellung fehlgeschlagen"

    End If

    

End Sub



Function ErstellePfad(sPfad As String) As Boolean

    Dim fso    As Object

    

    ' FSO-Objekt erstellen

    Set fso = CreateObject("Scripting.FileSystemObject")

    

    ' Überprüfen, ob der Ordner existiert, andernfalls erstellen

    If Not fso.FolderExists(sPfad) Then

        fso.CreateFolder sPfad

        If fso.FolderExists(sPfad) Then

            ErstellePfad = True

        Else

            ErstellePfad = False

        End If

    Else

        ErstellePfad = True

    End If

    ' Aufräumen

    Set fso = Nothing

End Function

AW: PDF Ausdruck speichern

31.03.2025 22:39:29

Yal

Hallo Joachim,

hmm... habe mir zu viel Zeit gelassen. Ralf hat schon geliefert :-) Egal.

Nach dem Prinzip "do not repeat yourself" (vermeide Wiederholung), mein Vorschlag:

Sub PDF_drucken_Gesamt()

Dim Name$, Berechnungen$, PDF$, Investoren$, InvestorenName$ '$ ist Kurzform von "As String"

Dim Pfad1, Pfad2$

Const cBasisPfad = "C:\Users\Admin\GSN-Cloud\Joachim Baum SHARE\Kunden"



    With Worksheets("Grundlagen")

        Name = .Range("AE6").Value 'Projektname

        Berechnungen = .Range("AE5").Value 'Berechnungen

        PDF = .Range("AF4").Value 'PDF

        Investoren = .Range("AE19").Value 'Investoren

        InvestorenName = .Range("AF19").Value 'Investoren Namen



        Select Case .Range("AF24").Value

        Case 1, 2

            MsgBox "Es fehlt einen Investor oder ein Projekt oder beiden!"

            Exit Sub

        Case 4

            GoTo Investoren

        End Select

    End With

    

    Pfad_erzeugen cBasisPfad, Name

    Pfad_erzeugen cBasisPfad, Name, Berechnungen

    Pfad1 = Pfad_erzeugen(cBasisPfad, Name, Berechnungen, PDF)

    Pfad1 = Pfad1 & "\" & ActiveSheet.Range("BB7").Value

    ActiveWorkbook.ExportAsFixedFormat Filename:=Pfad1, _

        Type:=xlTypePDF, From:=1, To:=6, _

        Quality:=xlQualityStandard, IncludeDocProperties:=True, _

        IgnorePrintAreas:=False, OpenAfterPublish:=True



Investoren:

    Pfad_erzeugen cBasisPfad, Name

    Pfad_erzeugen cBasisPfad, Name, Investoren

    Pfad_erzeugen cBasisPfad, Name, Investoren, InvestorenName

    Pfad2 = Pfad_erzeugen(cBasisPfad, Name, Investoren, InvestorenName, PDF)

    Pfad2 = Pfad2 & "\" & ActiveSheet.Range("BC2").Value

    CreateObject("Scripting.FileSystemObject").CopyFile Pfad1, Pfad2

End Sub



Private Function Pfad_erzeugen(ParamArray Pfad()) As String

Dim strPfad As String

    strPfad = Join(Pfad, "\")

    If Dir(strPfad, vbDirectory) = "" Then VBA.MkDir strPfad

    Pfad_erzeugen = strPfad

End Function

Du speicherst dieselbe Datei an 2 verschiedenen Stellen. Die Datei muss aber nicht zweimal erzeugt werden
OpenAfterPublish würde ich auf False setzen.

VG
Yal

Forumthread: PDF Ausdruck speichern

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread