导出为固定格式生成运行时错误:文件是只读的

Question

当用户单击"打印按钮"时，活动表应打印为PDF。

我对.ExportAsFixedFormat方法有问题。我收到以下错误消息：

运行时错误"-2147018887 (80071779("：自动化错误，文件是只读的

这是代码：

Sub PrintButtonClick()
'++++Print to PDF Function++++
'For more Information: https://learn.microsoft.com/de-de/office/vba/api/excel.worksheet.exportasfixedformat
'DEPENDS ON LOCATION OF HEADING (Heading row index/column index)
'allows to print material information, NO general list of materials
    DataBaseSheet.Unprotect password:=pw
    'PRINT PROCEDURE:
    If DataBaseSheet.Cells(5, 5).value = "Print" Then
        'Error in following line!!!!!
        DataBaseSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
          DataBaseSheet.Cells(5, 5) & ".pdf", Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, IgnorePrintAreas:=True, _ 
          OpenAfterPublish:=True
    Else: MsgBox "You cannot print this sheet"
    End If
    DataBaseSheet.Cells(2, 2).Locked = False
    DataBaseSheet.Protect password:=pw
End Sub

Answer 1

您收到该错误是因为您尝试覆盖当前打开的同名 pdf？当我说OPEN时，我的意思不是在Web浏览器中打开，而是在Adobe Reader等应用程序中打开...关闭打开的文件，然后重试:)

或者，签入代码文件是否打开，然后尝试编写它。请参阅此示例。

Sub PrintButtonClick()
    Dim pdfFileName As String
    With DataBaseSheet
        .Unprotect Password:=pw
        pdfFileName = .Cells(5, 5).Value
        If pdfFileName = "Print" Then
            pdfFileName = .Cells(5, 5) & ".pdf"
            If IsPDFOpen(pdfFileName) Then
                MsgBox "A pdf with the same name is currently open. Please close that and try again"
            Else
                .ExportAsFixedFormat Type:=xlTypePDF, FileName:=pdfFileName, _
                                     Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                     IgnorePrintAreas:=True, OpenAfterPublish:=True
            End If
        Else
            MsgBox "You cannot print this sheet"
        End If
        .Cells(2, 2).Locked = False
        .Protect Password:=pw
    End With
End Sub
'~~> Function to check if the pdf with same name is open
Function IsPDFOpen(FileName As String)
    Dim ff As Long, ErrNo As Long
    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0
    Select Case ErrNo
    Case 70:   IsPDFOpen = True
    Case Else: IsPDFOpen = False
    End Select
End Function