vba - 无法在一台计算机上从 Excel/VBA 保存 PDF

Question

我最近在这里收到了有关我们拥有的 Excel 电子表格的帮助，该电子表格允许用户为客户创建报价单。该电子表格使用 VBA 允许用户按下一个按钮，该按钮从某些工作表中生成 PDF，并将它们附加到新的 Outlook 电子邮件中。

不幸的是，这不适用于用户的其中一台计算机。问题似乎与 PDF 的生成有关。最初按下按钮时，什么也没发生。我怀疑这与 Microsoft Add-in to Save as PDF 有关，所以我确保它已安装，确实如此。在“注释掉”来自代码的错误消息以获取来自 Visual Basic 的真正错误消息之后，我发现它是这样的:

run-time error '-2147467261 (80004003)': Document not saved.

单击“调试”时，它会突出显示:

FileName = Create_PDF_Sheet_Level_Names(NamedRange:="addtopdf1", _
                                        FixedFilePathName:=ThisWorkbook.Path & "\" & "Quotation - " & Range("G18") & ".pdf", _
                                        OverwriteIfFileExist:=True, _
                                        OpenPDFAfterPublish:=False)

这涉及到:

Function Create_PDF_Sheet_Level_Names(NamedRange As String, FixedFilePathName As String, _
                                      OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
'This function will create a PDF with every sheet with
'a sheet level name variable <NamedRange> in it
    Dim FileFormatstr As String
    Dim Fname As Variant
    Dim Ash As Worksheet
    Dim sh As Worksheet
    Dim ShArr() As String
    Dim s As Long
    Dim SheetLevelName As Name

    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        'We fill the Array with sheets with the sheet level name variable
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Visible = -1 Then
                Set SheetLevelName = Nothing
                On Error Resume Next
                Set SheetLevelName = sh.Names(NamedRange)
                On Error GoTo 0
                If Not SheetLevelName Is Nothing Then
                    s = s + 1
                    ReDim Preserve ShArr(1 To s)
                    ShArr(s) = sh.Name
                End If
            End If
        Next sh

        'We exit the function If there are no sheets with
        'a sheet level name variable named <NamedRange>
        If s = 0 Then Exit Function

        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

        Application.ScreenUpdating = False
        Application.EnableEvents = False

        'Remember the ActiveSheet
        Set Ash = ActiveSheet

        'Select the sheets with the sheet level name in it
        Sheets(ShArr).Select

        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        ActiveSheet.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_Sheet_Level_Names = Fname
        End If

        Ash.Select

        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
End Function

我真的在这里挠头!在 Excel 和 Outlook 上与我的机器并排检查所有设置，包括信任中心设置。还检查了加载项。

Answer 1

请检查用户要保存 PDF 文件的磁盘空间是否足够!

我建议在调用“ActiveSheet.ExportAsFixedFormat(...)”之前检查 PDF 全名的长度(路径、文件名和文件扩展名；在您的示例中，它是变量“Fname”)，因为文件名(或者更确切地说全名)在 Microsoft Windows 下通常不能超过 255 个字符(参见:Naming Files, Paths, and Namespaces)。