VBA pdf erzeugen und speichern

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: VBA pdf erzeugen und speichern
von: WalterK
Geschrieben am: 27.04.2015 18:28:12

Hallo,
der folgende Code sollte aus einer Tabelle eine PDF-Datei erzeugen und falls im Blatt Menü in der Zelle A30 ein Pfad angegeben ist die Datei beiom angegebenen Pfad speichern, oder falls die Zelle A30 leer ist sollte die Datei automatisch auf dem Desktop gespeichert werden.
Es kommt aber der Fehler: Laufzeitfehler 1004 - Anwendungs- oder objektdefinierter Fehler

Sub PDF_Alle_Alphabetisch()
    Dim WshShell As Object
    Dim wksAlph As Worksheet
    Dim wksMenü As Worksheet
    Dim Pfad As String
    Set wksAlph = Worksheets("Alle_Alphabetisch")
    Set wksMenü = Worksheets("MENÜ und NAVIGATION")
    Set WshShell = CreateObject("WScript.Shell")
    
    wksMenü.Range("A31") = WshShell.SpecialFolders("Desktop")
    
    If wksMenü.Range("A30") = "" Then
            Pfad = wksMenü.Range("A31").Value
        Else
            Pfad = wksMenü.Range("A30").Value
    End If
    
    wksAlph.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad & "\" & wksAlph.Range("B8"). _
Value & "_" & wksAlph.Range("B3").Value & "_" & Date & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
        
    wksMenü.Range("A31").ClearContents
    
    Set WshShell = Nothing
End Sub
Bitte um Ergänzung bzw. Berichtigung zum Erreichen meines Zieles.
Besten Dank und Servus, Walter

Bild

Betrifft: AW: VBA pdf erzeugen und speichern
von: Nepumuk
Geschrieben am: 28.04.2015 07:41:36
Hallo,
nicht nachvollziehbar. Was steht denn in Zelle B8 und B3 der Tabelle? Eventuell mag dein Excel die Punkte im Datum nicht.
Gruß
Nepumuk

Bild

Betrifft: AW: VBA pdf erzeugen und speichern-Dateiname prüfe
von: fcs
Geschrieben am: 28.04.2015 08:32:31
Hallo Walter,
entweder ist das Verzeichnis nicht vorhanden, oder der aus den Zellinhalten generierte Dateiename enthält für Dateinamen unzulässige Zeichen.
Außerdem ist es sinnvoll, das Datum im Format JJJJ-MM-TT oder JJJJMMTT einzubauen.
Gruß
Franz

Sub PDF_Alle_Alphabetisch()
    Dim WshShell As Object
    Dim wksAlph As Worksheet
    Dim wksMenü As Worksheet
    Dim Pfad As String
    Dim Dateiname As String
    
    Set wksAlph = Worksheets("Alle_Alphabetisch")
    Set wksMenü = Worksheets("MENÜ und NAVIGATION")
    Set WshShell = CreateObject("WScript.Shell")
    
    Dateiname = wksAlph.Range("B8").Value & "_" _
                & wksAlph.Range("B3").Value & "_" & Format(Date, "YYYY-MM-DD") & ".pdf"
    If fncDateiname_Check(strText:=Dateiname) = False Then
        MsgBox "Dateiname" & vbLf & Dateiname & vbLf _
            & "enthält eines der unzulässigen/ungünstigen Zeichen " & _
            """  '  /  \  :  |  *  ?  <  >  [ ]", _
            vbOKOnly, "PDF_Alle_Alphabetisch"
    Else
        wksMenü.Range("A31") = WshShell.SpecialFolders("Desktop")
        
        If wksMenü.Range("A30") = "" Then
                Pfad = wksMenü.Range("A31").Value
            Else
                Pfad = wksMenü.Range("A30").Value
        End If
        If Dir(Pfad, vbDirectory) <> "" Then
            wksAlph.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad & "\" & Dateiname, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
 _
                OpenAfterPublish:=False
        Else
            MsgBox "Verzeichnis" & vbLf & Pfad & vbLf & "existiert nicht!", _
                    vbOKOnly, "PDF_Alle_Alphabetisch"
        End If
        wksMenü.Range("A31").ClearContents
        
    End If
    Set WshShell = Nothing
    
End Sub
Function fncDateiname_Check(strText As String) As Boolean
    'Ungültige Zeichen in Dateinamem
    'Anführungszeichen ("), Schrägstrich (/), umgekehrter Schrägstrich (\), _
        Doppelpunkt (:), vertikale Linie (|), Stern (*), Fragezeichen (?), _
        kleiner (<), gößer (>), eckige Klammer aus ([), eckige Klammer zu (])
    'ungünstige Zeichen in Dateinamem
    'Apostroph (')
    Dim arrZeichen, intZeichen As Integer
    
    fncDateiname_Check = True
    arrZeichen = Array("""", "'", "/", "\", ":", "|", "*", "?", "<", ">", "[", "]")
    For intZeichen = LBound(arrZeichen) To UBound(arrZeichen)
        If InStr(1, strText, arrZeichen(intZeichen)) > 0 Then
            fncDateiname_Check = False
            Exit For
        End If
    Next
End Function


Bild

Betrifft: Perfekt! Besten Dank und Servus, Walter
von: WalterK
Geschrieben am: 28.04.2015 17:40:27


 Bild

Beiträge aus den Excel-Beispielen zum Thema "VBA pdf erzeugen und speichern"