簡體   English   中英

Excel VBA代碼可在Mac上運行,創建PDF函數

[英]Excel VBA code to work on Mac, Create PDF Function

我已經編寫了以下函數。 但是,我無法在Office Mac上使用它。 我不確定找到等效的EXP_PDF.DLL mac的過程

Function Create_PDF(Myvar As Object, FixedFilePathName As String, _                    
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String    

Dim FileFormatstr As String    
Dim FName As Variant

'Test If the Microsoft Add-in is installed    
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
        If FixedFilePathName = "" Then            
           'Open the GetSaveAsFilename dialog to enter a file name for the pdf            
           FileFormatstr = "PDF Files (*.pdf), *.pdf"            
           FName = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _                                                                                       Title:="Create PDF")
            'If you cancel this dialog Exit the function            
            If FName = False Then Exit Function        
         Else            
            FName = FixedFilePathName        
        End If
        'If OverwriteIfFileExist = False we test if the PDF        
         'already exist in the folder and Exit the function if that is True        
        If OverwriteIfFileExist = False Then            
            If Dir(FName) <> "" Then Exit Function        
        End If

       'Now the file name is correct we Publish to PDF        
       On Error Resume Next        
       Myvar.ExportAsFixedFormat _                
                Type:=xlTypePDF, _                
                FileName:=FName, _                
                Quality:=xlQualityStandard, _                
                IncludeDocProperties:=True, _                
                IgnorePrintAreas:=False, _                
                OpenAfterPublish:=OpenPDFAfterPublish        
        On Error GoTo 0

        'If Publish is Ok the function will return the file name        
         If Dir(FName) <> "" Then Create_PDF = FName    

End If
End Function

無需檢查該特定DLL的存在,因為在MacOS下,PDF導出支持是本機的。 如果您刪除了Add-in檢查並刪除了FileFilter字符串,那么您的代碼就可以正常工作:

Function Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String

Dim FileFormatstr As String
Dim FName As Variant

    If FixedFilePathName = "" Then
       'Open the GetSaveAsFilename dialog to enter a file name for the pdf
       FName = Application.GetSaveAsFilename("", Title:="Create PDF")
        'If you cancel this dialog Exit the function
        If FName = False Then Exit Function
     Else
        FName = FixedFilePathName
    End If
    'If OverwriteIfFileExist = False we test if the PDF
     'already exist in the folder and Exit the function if that is True
    If OverwriteIfFileExist = False Then
        If Dir(FName) <> "" Then Exit Function
    End If

   'Now the file name is correct we Publish to PDF
   On Error Resume Next
   Myvar.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=FName, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=OpenPDFAfterPublish
    On Error GoTo 0

    'If Publish is Ok the function will return the file name
     If Dir(FName) <> "" Then Create_PDF = FName

End Function

GetSaveAsFilename削弱在MacOS和不允許通過的文件類型過濾文件。 如果需要將用戶限制為某種文件類型,則可以使用AppleScript並執行以下操作:

Function Create_PDF_Mac(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String

Dim FileFormatstr As String
Dim FName As Variant

    If FixedFilePathName = "" Then
       'Open the GetSaveAsFilename dialog to enter a file name for the pdf
       'FName = Application.GetSaveAsFilename("", ".PDF", Title:="Create PDF")

        On Error Resume Next
        ThePath = MacScript("return (path to documents folder) as String")

        TheScript = _
        "set applescript's text item delimiters to "","" " & vbNewLine & _
        "set theFile to (choose file name with prompt ""Save As File"" " & _
            "default name ""untitled.pdf"" default location alias """ & _
            ThePath & """ ) as string" & vbNewLine & _
        "if theFile does not end with "".pdf"" then set theFile to theFile & "".pdf"" " & vbNewLine & _
        "set applescript's text item delimiters to """" " & vbNewLine & _
        "return theFile"

           FName = MacScript(TheScript)
        On Error GoTo 0

        'If you cancel this dialog Exit the function
        If FName = False Then Exit Function
     Else
        FName = FixedFilePathName
    End If
    'If OverwriteIfFileExist = False we test if the PDF
     'already exist in the folder and Exit the function if that is True
    If OverwriteIfFileExist = False Then
        If Dir(FName) <> "" Then Exit Function
    End If

   'Now the file name is correct we Publish to PDF
   On Error Resume Next
   Myvar.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=FName, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=OpenPDFAfterPublish
    On Error GoTo 0

    'If Publish is Ok the function will return the file name
     If Dir(FName) <> "" Then Create_PDF = FName

End Function

您可以使用OS選擇器開關為每個OS運行適當的功能:

#If Mac Then
    savedFileName = Create_PDF_Mac(...)
#Else
    savedFileName = Create_PDF_PC(...)
#End If

考慮到MacOS中默認VB功能的局限性,這也是Microsof建議的方法

這是有關如何在較新版本的Mac Excel中進行操作的指南: https : //www.rondebruin.nl/mac/mac034.htm

重要的是您不能將文件保存到您選擇的位置。

必須將其保存到當前用戶主目錄下的Library/Group Containers/UBF8T346G9.Office文件夾中,因此在大多數情況下,是/Users/[current user]/Library/Group Containers/UBF8T346G9.Office 如果文件夾不存在,則必須創建它。 (請參見上面鏈接的頁面上的代碼示例)

羅恩!

請對此投票由MS修復, 網址為https : //excel.uservoice.com/forums/304933-excel-for-mac/suggestions/36531559-fix-exportasfixedformat-method

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM