Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

VBA pdf erzeugen und speichern

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

  

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


  

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



  

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




 

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