Question

我创建了一个宏来将范围从工作表保存到PDF文件。当我运行宏时，它会出错：

执行应用程序定义或对象定义期间的错误1004 错误

我注意到当我从其工作的范围中删除J109:Y157,Z158:AS187时。当我尝试该范围而不是其余时，它工作正常。当它们在范围内时它就不起作用。

突出显示的区域是：

Sheets("JSA-CE NTR klapbordessen").Range(ranges).ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=CurrentFolder & FileName & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

这是代码：

Sub Range_to_PDF()

Dim ranges As String
Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String


'Informatie over Excel bestand
myPath = ActiveWorkbook.FullName
CurrentFolder = ActiveWorkbook.Path & "\"
FileName = Mid(myPath, InStrRev(myPath, "\") + 1, _
InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)

'Gebied voor PDF
ranges = ("A42:H108,J109:Y157,Z158:AS187,AT187:BC235,AT237:BC285,AT287:BC335,AT337:BC385,AT387:BC435,AT437:BC485,AT487:BC535,AT537:BC585,AT587:BC635,AT637:BC685,AT687:BC735,AT737:BC785,AT787:BC835,AT837:BC885,AT887:BC935," & _
            "AT937:BC985,AT987:BC1035,AT1037:BC1085,AT1087:BC1135,AT1137:BC1185")

'Controle of er al een bestand met dezelfde naam is
Do While UniqueName = False
    DirFile = CurrentFolder & FileName & ".pdf"

    If Len(Dir(DirFile)) <> 0 Then
      UserAnswer = MsgBox("Bestand bestaat al! Klik " & _
       "[Ja] om te overschrijven. Klik [Nee] om te hernoemen.", vbYesNoCancel)

      If UserAnswer = vbYes Then
        UniqueName = True
      ElseIf UserAnswer = vbNo Then
        Do
          'Retrieve New File Name
            FileName = Application.InputBox("Geef een nieuwe bestandsnaam " & _
             "(Vraagt opnieuw als het een verkeerde bestandsnaam is)", , _
             FileName, Type:=2)

          'Exit if User Wants To
            If FileName = "False" Or FileName = "" Then Exit Sub
        Loop While ValidFileName(FileName) = False
      Else
        Exit Sub 'Cancel
      End If
    Else
      UniqueName = True
    End If
  Loop

'Aanpassen aan pagina formaat
With Worksheets("JSA-CE NTR klapbordessen").PageSetup
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With


'Opslaan van PDF
Sheets("JSA-CE NTR klapbordessen").Range(ranges).ExportAsFixedFormat _
        Type:=xlTypePDF, _
        FileName:=CurrentFolder & FileName & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

'Deactiveer pagina onderbreking
  ActiveSheet.DisplayPageBreaks = False
  ActiveSheet.Select

'Bevestig opslaan aan gebruiker
  With ActiveWorkbook
    FolderName = Mid(.Path, InStrRev(.Path, "\") + 1, Len(.Path) - InStrRev(.Path, "\"))
  End With

  MsgBox "PDF opgeslagen in de map: " & CurrentFolder

Exit Sub

'Error Handlers
ProblemSaving:
  MsgBox "Er was een probleem met het opslaan van de PDF. Dit is vaak" & _
   " doordat het originele PDF bestand al open is."
  Exit Sub

End Sub

Function ValidFileName(FileName As String) As Boolean

Dim TempPath As String
Dim wb As Workbook

'Determine Folder Where Temporary Files Are Stored
  TempPath = Environ("TEMP")

'Create a Temporary XLS file (XLS in case there are macros)
  On Error GoTo InvalidFileName
    Set wb = ActiveWorkbook.SaveAs(ActiveWorkbook.TempPath & _
     "\" & FileName & ".xls", xlExcel8)
  On Error Resume Next

'Delete Temp File
  Kill wb.FullName

'File Name is Valid
  ValidFileName = True

Exit Function

'ERROR HANDLERS
InvalidFileName:
  'File Name is Invalid
    ValidFileName = False

End Function

此外，当我选择更改文件名并在该框中的“取消”后单击时，我收到错误消息：

编译错误：预期函数或变量

这是功能部分。突出显示的区域是函数的第一行（Funtion ValidFileName等）。

我不是编码方面的专家，说实话，我不知道会出现什么问题。我试图谷歌错误，但我不明白如何将这些解决方案应用于我的代码。这段代码也是几个网站的混合。

Answer 1

我不相信SaveAs会返回一个对象。尝试从该行中删除Set wb =，然后删除此Kill wb.FullName

如果您确实想要删除它，请改为：

ActiveWorkbook.Close False
Kill ActiveWorkbook.FullName

Excel 2013/2016宏错误1004

1 个答案: