Just nu i M3-nätverket
Jump to content

PDF export problem


Alexej32

Recommended Posts

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

Link to comment
Share on other sites

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


Link to comment
Share on other sites

 

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

Link to comment
Share on other sites

Archived

This topic is now archived and is closed to further replies.



×
×
  • Create New...