Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA spezifischer Code für PDF Speichern mit Ordner

VBA spezifischer Code für PDF Speichern mit Ordner
25.01.2018 18:37:50
Jamie
Hallo Zusammen
ich suche nach einem VBA Code, welcher folgende Funktion mit sich bringt:
  • Arbeitsblatt in PDF speichern

  • Das File soll im Ordner mit dem Wert von E10 gespeichert werden

  • Bei E10 wäre eine Zahl zB: 28 - Daher müsste das PDF im Ordner 28 gespeichert werden.
  • Der Name des Files müsste wie auch beim PDF versenden im Excel gleich klingen

  • strPDFRapport = ThisWorkbook.Path & Application.PathSeparator _
    & "Filiale " & Format(.Range("E10").Value, "000") _
    & " Rapport " & Format(Date, "YYYY-MM-DD") & ".PDF"
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPDFRapport, _
    Quality:=xlQualityStandard, IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    

    der heutige Code für den Mailversand im PDF lautet:
     'E-Mailversand
    If LCase(Left(Application.OperatingSystem, 7)) = "windows" Then
    'Mail-/PDF-Versand unter Windows/MS-Office/MS-Outlook
    'PDF-Dateien speichern   - Funktion unter MAC ?
    bolRetouren = (.Cells(16, 5).Value = "_" Or .Cells(16, 5).Value = "þ")
    'Rapport als PDF speichern
    strPDFRapport = ThisWorkbook.Path & Application.PathSeparator _
    & "Filiale " & Format(.Range("E10").Value, "000") _
    & " Rapport " & Format(Date, "YYYY-MM-DD") & ".PDF"
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPDFRapport, _
    Quality:=xlQualityStandard, IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    If bolRetouren Then
    'Retourenblatt als PDF speichern
    Sheets("RETOURENFORMULAR").Select
    strPDFRetouren = ThisWorkbook.Path & Application.PathSeparator _
    & "Filiale " & Format(.Range("E10").Value, "000") _
    & " Retouren " & Format(Date, "YYYY-MM-DD")
    strPDFRetouren = strPDFRetouren & ".pdf"
    strXLSRetouren = strPDFRetouren & ".xlsx"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPDFRetouren, _
    Quality:=xlQualityStandard, IncludeDocProperties:=False, _
    IgnorePrintAreas:=False, OpenAfterPublish:=False
    Call SpeichernRetourenFormular(strFilename:=strXLSRetouren, lngFileformat:=51)
    Sheets("RAPPORT").Select
    End If
    'Mailversand via Outlook
    Call fncMailOutlook(varTo:=.Range("J13").Text, _
    strSubject:=.Range("B10").Text & " " & .Range("C10").Text _
    & " / " & .Range("B11").Text & " " & .Range("C11").Text _
    & " " & .Range("E10").Text & " " & .Range("E11").Text, _
    strBody:="Geschätzte Filialleitung, geschätzte Einkaufsleitung" & Chr(10) & Chr( _
    _10) _
    & "Anbei senden wir Ihnen den gewünschter Rapport Ihrer Fust Filiale zu.",   _
    _
    olAction:="Display", varCC:=.Range("L13").Text, varBCC:="", _
    varAttachments:=IIf(bolRetouren, Array(strPDFRapport, strPDFRetouren,  _
    strXLSRetouren), _
    strPDFRapport))
    Else 
    
    könnt ihr mir dabei helfen?
    Lg
    Jamie

    1
    Beitrag zum Forumthread
    Beitrag zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: VBA spezifischer Code für PDF Speichern mit Ordner
    29.01.2018 15:34:13
    Peter(silie)
    Hallo,
    so ganz verstehe ich nicht was du eigentlich willst...
    Der Betreff und dein Text beschreiben etwas anderes als dein Code,
    geht es dir nun um das speichern eines Worksheets als PDF oder um
    das versenden einer Outlook Mail mit Anhang?
    Falls du einfach nur dein Worksheet als PDF in irgendeinem Ordner speichern willst,
    dann schau dir den Code unten an und durchlaufe ihn mit dem Debugger Schritt für Schritt
    Die Funktionen Folder_Exists/ File_Exists prüfen ob es den Ordner oder die Datei gibt.
    Solltest du evtl benutzen um zu verhindern dass fehlermeldungen o.ä, kommen
    
    Public Sub a()
    Dim Save_Path As String
    Save_Path = "C:\Dein\Pfad" & ThisWorkbook.Sheets(1).Range("E10").Value & "\Dein_Dateiname"
    Worksheet_To_PDF ThisWorkbook.Sheets(1), Save_Path
    End Sub
    Public Function Worksheet_To_PDF(ByVal Worksheet_ As Variant, Optional ByVal Save_Path As  _
    Variant) As Boolean
    If Not Get_Variable_Type(Worksheet_) = vbObject Then Exit Function
    If IsMissing(Save_Path) Then Save_Path = Defaultpath_VBAgent(".pdf")
    If Not Worksheet_ Is Nothing Then
    Worksheet_.ExportAsFixedFormat xlTypePDF, Save_Path, _
    xlQualityStandard, True, False, , , False
    End If
    End Function
    Public Function Defaultpath_VBAgent(ByVal exte As String) As String
    Defaultpath_VBAgent = Application.DefaultFilePath & "\DirectoryAgent_File_" & _
    Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "hh-mm-ss") & exte
    End Function
    Public Function File_Exists(ByVal File_Path As String) As Boolean
    If Dir(File_Path, vbDirectory)  vbNullString Then File_Exists = True
    End Function
    Public Function Folder_Exists(ByVal Folder_Path As String) As Boolean
    If Dir(Folder_Path, vbDirectory)  vbNullString Then Folder_Exists = True
    End Function
    Public Function Get_Variable_Type(ByVal myVar)
    Select Case VarType(myVar)
    Case vbNull: Get_Variable_Type = vbNull
    Case vbInteger: Get_Variable_Type = vbInteger
    Case vbLong: Get_Variable_Type = vbLong
    Case vbSingle: Get_Variable_Type = vbSingle
    Case vbDouble: Get_Variable_Type = vbDouble
    Case vbCurrency: Get_Variable_Type = vbCurrency
    Case vbDate: Get_Variable_Type = vbDate
    Case vbString: Get_Variable_Type = vbString
    Case vbObject: Get_Variable_Type = vbObject
    Case vbError: Get_Variable_Type = vbError
    Case vbBoolean: Get_Variable_Type = vbBoolean
    Case vbVariant: Get_Variable_Type = vbVariant
    Case vbDataObject: Get_Variable_Type = vbDataObject
    Case vbDecimal: Get_Variable_Type = vbDecimal
    Case vbByte: Get_Variable_Type = vbByte
    Case vbUserDefinedType: Get_Variable_Type = vbUserDefinedType
    Case vbArray: Get_Variable_Type = vbArray
    Case Else: Get_Variable_Type = vbNull
    End Select
    End Function
    

    Anzeige

    346 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige