如何在Mac计算机上将Excel VBA导出为PDF

时间:2019-06-11 21:56:58

标签: excel vba export-to-pdf excel-vba-mac

我的Excel文档具有宏代码。我想将活动工作表作为PDF文件导出到特定的文件夹。 Windows PC上可以使用相同的代码,但MAC PC上不能使用相同的代码。单击“保存”按钮时,它将打印pdf而不是保存它。我要保存。如果有人可以帮助我,我将非常高兴。

Sub Save_NEWPORT_ESTIMATE()

If Range("G1") = "INVOICE" Then

LigneIS = Application.CountA(Sheets("Invoice summary").Range("A:A"))
Sheets("Invoice summary").Range("A" & LigneIS + 1) = Now
Sheets("Invoice summary").Range("B" & LigneIS + 1) = Sheets("NANTUCKET ESTIMATE").Range("H8")
Sheets("Invoice summary").Range("C" & LigneIS + 1) = "NANTUCKET"
Sheets("Invoice summary").Range("D" & LigneIS + 1) = Sheets("NANTUCKET ESTIMATE").Range("A12")
Sheets("Invoice summary").Range("E" & LigneIS + 1) = Sheets("NANTUCKET ESTIMATE").Range("M49")

Else
    LigneIS = Application.CountA(Sheets("Invoice summary").Range("A:A"))
    Sheets("Estimate summary").Range("A" & LigneIS + 1) = Now
    Sheets("Estimate summary").Range("B" & LigneIS + 1) = 
    Sheets("NANTUCKET ESTIMATE").Range("H8")
    Sheets("Estimate summary").Range("C" & LigneIS + 1) = "NANTUCKET"
    Sheets("Estimate summary").Range("D" & LigneIS + 1) = 
    Sheets("NANTUCKET ESTIMATE").Range("A12")
    Sheets("Estimate summary").Range("E" & LigneIS + 1) = 
    Sheets("NANTUCKET ESTIMATE").Range("M49")

End If
    D1 = Format(Date, "ddmmyy")
    Customer = Left(Range("A12"), 6)
    Job = Range("G12")
    Tipe = Range("G1")
    Model = Range("G18")

If Tipe = "INVOICE" Then
Tipe2 = "1 SALES INVOICES"
Else
Tipe2 = "1 ESTIMATES"
End If

Lien = "/Users/macbookpro/Desktop/INVOICE/" & Tipe2

ChDir "/Users/macbookpro/Desktop/INVOICE/" & Tipe2

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Lien & "\" & D1 & " " & Model & "_" & Customer & "_" & Job & "_" & Tipe & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True

End Sub

Sub Save_NANTUCKET_ESTIMATE()

If Range("G1") = "INVOICE" Then
LigneIS = Application.CountA(Sheets("Invoice summary").Range("A:A"))
Sheets("Invoice summary").Range("A" & LigneIS + 1) = Now
Sheets("Invoice summary").Range("B" & LigneIS + 1) = Sheets("NANTUCKET ESTIMATE").Range("H8")
Sheets("Invoice summary").Range("C" & LigneIS + 1) = "NANTUCKET"
Sheets("Invoice summary").Range("D" & LigneIS + 1) = Sheets("NANTUCKET ESTIMATE").Range("A12")
Sheets("Invoice summary").Range("E" & LigneIS + 1) = Sheets("NANTUCKET ESTIMATE").Range("M49")
Else
LigneIS = Application.CountA(Sheets("Invoice summary").Range("A:A"))
Sheets("Estimate summary").Range("A" & LigneIS + 1) = Now
Sheets("Estimate summary").Range("B" & LigneIS + 1) = Sheets("NANTUCKET ESTIMATE").Range("H8")
Sheets("Estimate summary").Range("C" & LigneIS + 1) = "NANTUCKET"
Sheets("Estimate summary").Range("D" & LigneIS + 1) = Sheets("NANTUCKET ESTIMATE").Range("A12")
Sheets("Estimate summary").Range("E" & LigneIS + 1) = Sheets("NANTUCKET ESTIMATE").Range("M49")
End If

D1 = Format(Date, "ddmmyy")
Customer = Left(Range("A12"), 6)
Job = Range("G12")
Tipe = Range("G1")
Model = Range("G18")
If Tipe = "INVOICE" Then
Tipe2 = "1 SALES INVOICES"
Else
Tipe2 = "1 ESTIMATES"
End If

Lien = "/Users/macbookpro/Desktop/INVOICE/" & Tipe2

ChDir "/Users/macbookpro/Desktop/INVOICE/" & Tipe2

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Lien & "\" & D1 & " " & Model & "_" & Customer & "_" & Job & "_" & Tipe & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
End Sub

1 个答案:

答案 0 :(得分:0)

我不确定此请求是否仍然有效,但是我找到了解决方法

http://www.rondebruin.nl/mac/mac005.htm

在Mac上,导出到PDF参数的反应似乎不同于在Windows PC上,并且您需要一种变通方法,将PDF保存到用户Library文件夹中,尤其是保存到Office Library文件夹中。关键功能是这个

    Function CreateFolderinMacOffice2016(NameFolder As String) As String
    'Function to create folder if it not exists in the Microsoft Office Folder
    'Ron de Bruin : 1-Feb-2019
    Dim OfficeFolder As String
    Dim PathToFolder As String
    Dim TestStr As String

    OfficeFolder = MacScript("return POSIX path of (path to desktop folder) as string")
    OfficeFolder = Replace(OfficeFolder, "/Desktop", "") & _
        "Library/Group Containers/UBF8T346G9.Office/"

    PathToFolder = OfficeFolder & NameFolder

    On Error Resume Next
    TestStr = Dir(PathToFolder & "*", vbDirectory)
    On Error GoTo 0
    If TestStr = vbNullString Then
        MkDir PathToFolder
        'You can use this msgbox line for testing if you want
        'MsgBox "You find the new folder in this location :" & PathToFolder
    End If
    CreateFolderinMacOffice2016 = PathToFolder
End Function

使用此功能创建文件夹并直接使用返回值作为文件路径将使它起作用。

所有归功于罗恩·德布鲁因(Ron de Bruin),我只是复制了此内容以提供帮助。访问他的页面以获取更多示例。