Question

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

不幸的是，这不适用于用户的某台计算机。问题似乎在于生成PDF。最初按下按钮时，没有任何反应。我怀疑这与使用Microsoft加载项保存为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文件！
我建议在调用＆＃34; ActiveSheet.ExportAsFixedFormat（之前）之前检查PDF全名的长度（路径，文件名和文件扩展名;在您的示例中，它是变量＆＃34; Fname＆＃34;） ...）＆＃34;，因为Microsoft Windows下的文件名（或者更确切地说是全名）通常不能超过255个字符（参见：Naming Files, Paths, and Namespaces）。

无法在一台计算机上保存Excel / VBA中的PDF

1 个答案: