Just nu i M3-nätverket
Gå till innehåll

PDF export problem


Alexej32

Rekommendera Poster

Hej,

 

Jag har en arbetsbok som innehåller en pdf export makro som ska sparar PDF filen  under mapp som arbetsboken och under samma namn som arbetsboken. Det jag önskar är att den sparar filen under samma namn som den aktiva arbetsbladet. Jag har försök att modifiera makrot men utan framgång, jag er inte tillräcklig kunnig i VBA  för att lösa detta :(  :( . Försökt googla detta men hittade ingen bra lösning  :(

 

 

Sub Save_as_pdf()

Dim FSO As Object

Dim s(1) As String

Dim sNewFilePath As String

 

    Set FSO = CreateObject("Scripting.FileSystemObject")

    s(0) = ActiveWorkbook.FullName

    

    If FSO.FileExists(s(0)) Then

        '//Change Excel Extension to PDF extension in FilePath

        s(1) = FSO.GetExtensionName(s(0))

        If s(1) <> "" Then

            s(1) = "." & s(1)

            sNewFilePath = Replace(s(0), s(1), ".pdf")

            

            '//Export to PDF with new File Path

            ActiveSheet.ExportAsFixedFormat _

                Type:=xlTypePDF, _

                Filename:=sNewFilePath, _

                Quality:=xlQualityStandard, IncludeDocProperties:=True, _

                IgnorePrintAreas:=False, OpenAfterPublish:=True

        End If

    Else

        '//Error: file path not found

        MsgBox "Error: this workbook may be unsaved.  Please save and try again."

    End If

    

    Set FSO = Nothing

 

End Sub

Länk till kommentar
Dela på andra webbplatser

Ove Söderlund

Mitt förslag blir detta:

Har rensat lite i koden då vi inte behöver fiffla med sök och ersätta och dimensionera med matriser.


Sub Save_as_pdf()

    Dim FSO As Object

    Dim sNewFilePath As String

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FileExists(ActiveWorkbook.FullName) Then

        sNewFilePath = ActiveWorkbook.Path & "\" & ActiveSheet.Name & ".pdf"

        '//Export to PDF with new File Path
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNewFilePath, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=True

    Else

        '//Error: file path not found
        MsgBox "Error: this workbook may be unsaved.  Please save and try again."

    End If

    Set FSO = Nothing

End Sub


Länk till kommentar
Dela på andra webbplatser

 

Mitt förslag blir detta:

Har rensat lite i koden då vi inte behöver fiffla med sök och ersätta och dimensionera med matriser.


Sub Save_as_pdf()

    Dim FSO As Object

    Dim sNewFilePath As String

    Set FSO = CreateObject("Scripting.FileSystemObject")

    If FSO.FileExists(ActiveWorkbook.FullName) Then

        sNewFilePath = ActiveWorkbook.Path & "\" & ActiveSheet.Name & ".pdf"

        '//Export to PDF with new File Path
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNewFilePath, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=True

    Else

        '//Error: file path not found
        MsgBox "Error: this workbook may be unsaved.  Please save and try again."

    End If

    Set FSO = Nothing

End Sub


Klockrent! Fungerar perfekt  :)  :)  Många tack ! :D  :D

Länk till kommentar
Dela på andra webbplatser

Arkiverat

Det här ämnet är nu arkiverat och är stängt för ytterligare svar.

×
×
  • Skapa nytt...