Excel 2013/2016 macro Error 1004



我创建了一个宏,用于将工作表中的范围保存到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

此外,当我选择更改文件名,然后点击该框中的"取消"时,我会收到一个错误:

编译错误:预期的函数或变量

这在功能部分。突出显示的区域是函数的第一行(函数有效文件名等)

我不是编码专家,老实说,我不知道哪里出了问题。我试着用谷歌搜索这个错误,但我不知道如何将这些解决方案应用到我的代码中。这段代码也是由几个网站组合而成的。

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

如果你真的想删除它,可以这样做:

ActiveWorkbook.Close False
Kill ActiveWorkbook.FullName

最新更新