我有一些 VBA 代码(见下文),基本上将 excel 文件中的命名范围打印为 PDF。我为每个宏都设置了命令按钮,它工作正常,但是当我按顺序打印它们时(组 1、组 2、组 3....)当我到达组 6 时,文件突然关闭并强制计算机重新启动???
我做错了什么?任何帮助都将不胜感激。
谢谢
克里斯
Option Explicit
Sub Print_Group1()
Dim r As Range
Dim fDrive As String
fDrive = ThisWorkbook.Worksheets("Index").Range("S3").Value
ThisWorkbook.Worksheets("ReportGroups").Activate
Set r = ThisWorkbook.Worksheets("ReportGroups").Range("Groups_Reports")
r.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fDrive & "MyReports\PDF_Reports\Group1.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Worksheets("Index").Activate
ActiveWorkbook.Save
MsgBox "Done!", vbOKOnly
End Sub
Sub Print_Group2()
Dim r As Range
Dim fDrive As String
fDrive = ThisWorkbook.Worksheets("Index").Range("S3").Value
ThisWorkbook.Worksheets("Reports").Activate
Set r = ThisWorkbook.Worksheets("Reports").Range("All_Reports")
r.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fDrive & "MyReports\PDF_Reports\Group2.pdf.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Worksheets("Index").Activate
ActiveWorkbook.Save
MsgBox "Done!", vbOKOnly
End Sub
Sub Print_Group3()
Dim r As Range
Dim fDrive As String
fDrive = ThisWorkbook.Worksheets("Index").Range("S3").Value
ThisWorkbook.Worksheets("Reports").Activate
Set r = ThisWorkbook.Worksheets("Reports").Range("Report___000001, Report___000002, Report___000003, Report___000004, Report___000005, Report___000006")
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000007, Report___000008, Report___000009, Report___000010, Report___000011"))
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000012, Report___000013, Report___000014, Report___000015, Report___000016"))
r.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fDrive & "MyReports\PDF_Reports\Group3.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Worksheets("Index").Activate
ActiveWorkbook.Save
MsgBox "Done!", vbOKOnly
End Sub
Sub Print_Group4()
Dim r As Range
Dim fDrive As String
fDrive = ThisWorkbook.Worksheets("Index").Range("S3").Value
ThisWorkbook.Worksheets("Reports").Activate
Set r = ThisWorkbook.Worksheets("Reports").Range("Report___000017, Report___000018, Report___000019, Report___000020")
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000021, Report___000022, Report___000023, Report___000024"))
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000025, Report___000026, Report___000027, Report___000028"))
r.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fDrive & "MyReports\PDF_Reports\Group4.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Worksheets("Index").Activate
ActiveWorkbook.Save
MsgBox "Done!", vbOKOnly
End Sub
Sub Print_Group5()
Dim r As Range
Dim fDrive As String
fDrive = ThisWorkbook.Worksheets("Index").Range("S3").Value
ThisWorkbook.Worksheets("Reports").Activate
Set r = ThisWorkbook.Worksheets("Reports").Range("Report___000029, Report___000030, Report___000031, Report___000032, Report___000033, Report___000034")
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000035, Report___000036, Report___000037, Report___000038, Report___000039, Report___000040"))
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000041, Report___000042, Report___000043, Report___000044, Report___000045"))
r.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fDrive & "MyReports\PDF_Reports\Group5.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Worksheets("Index").Activate
ActiveWorkbook.Save
MsgBox "Done!", vbOKOnly
End Sub
Sub Print_Group6()
Dim r As Range
Dim fDrive As String
fDrive = ThisWorkbook.Worksheets("Index").Range("S3").Value
ThisWorkbook.Worksheets("Reports").Activate
Set r = ThisWorkbook.Worksheets("Reports").Range("Report___000046, Report___000047, Report___000048, Report___000049, Report___000050, Report___000051, Report___000052, Report___000053")
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000054, Report___000055, Report___000056, Report___000057, Report___000058, Report___000059, Report___000060, Report___000061"))
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000062, Report___000063, Report___000064, Report___000065, Report___000066, Report___000067"))
r.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fDrive & "MyReports\PDF_Reports\Group6.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Worksheets("Index").Activate
ActiveWorkbook.Save
MsgBox "Done!", vbOKOnly
End Sub
Sub Print_Group7()
Dim r As Range
Dim fDrive As String
fDrive = ThisWorkbook.Worksheets("Index").Range("S3").Value
ThisWorkbook.Worksheets("Reports").Activate
Set r = ThisWorkbook.Worksheets("Reports").Range("Report___000068, Report___000069, Report___000070, Report___000071")
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000072, Report___000073, Report___000074, Report___000075"))
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000076, Report___000077, Report___000078, Report___000079"))
r.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fDrive & "MyReports\PDF_Reports\Group7.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Worksheets("Index").Activate
ActiveWorkbook.Save
MsgBox "Done!", vbOKOnly
End Sub
Sub Print_Group8()
Dim r As Range
Dim fDrive As String
fDrive = ThisWorkbook.Worksheets("Index").Range("S3").Value
ThisWorkbook.Worksheets("Reports").Activate
Set r = ThisWorkbook.Worksheets("Reports").Range("Report___000080, Report___000081, Report___000082, Report___000083")
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000084, Report___000085, Report___000086"))
Set r = Union(r, ThisWorkbook.Worksheets("Reports").Range("Report___000087, Report___000088, Report___000089"))
r.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fDrive & "MyReports\PDF_Reports\Group8.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Worksheets("Index").Activate
ActiveWorkbook.Save
MsgBox "Done!", vbOKOnly
End Sub
答案1
这可能不会解决你的问题,但它会使你的代码很多更易于维护。
Public Sub PrintReportGroup(ByVal groupID As Long, ByVal startReport As Long, ByVal endReport As Long)
'consider making this a named range too!
Dim fDrive As String
fDrive = ThisWorkbook.Worksheets("Index").Range("S3").value
'you're working with named sheets, you don't need to .Activate them
'ThisWorkbook.Worksheets("Reports").Activate
With ThisWorkbook.Worksheets("Reports")
Dim counter As Long
For counter = startReport To endReport
Dim reportRange As Range
Set reportRange = Union(reportRange, .Range("reportReport___" & CStr(Format(counter, "000000"))))
Next
End With
reportRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fDrive & "MyReports\PDF_Reports\Group" & CStr(groupID) & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'You'll still be on the sheet you started with, so no need to return "home"
'Worksheets("Index").Activate
'Not sure why you're saving here - nothing you did during printing needs a save, but, this could be an oddly placed save for other changes made.
ActiveWorkbook.Save
'get rid of this MsgBox once it's all working ok
MsgBox "Done!", vbOKOnly
End Sub
现在您有一个可以调用它来制作多个 PDF 的过程:
Public Sub PrintReports()
PrintReportGroup 3, 1, 16
PrintReportGroup 4, 17, 28
PrintReportGroup 5, 29, 45
PrintReportGroup 6, 46, 67
'etc...
End Sub
通过修改该行,还可以方便地进行调试PrintReportGroup 6, 46 67
。将其更改为
PrintReportGroup 6, 46, 46
看看是否有效。如果有效,则将其更改为
PrintReportGroup 6, 46, 47
并继续前进,直到它爆炸。我猜任何一个缺少命名范围,或者您错误地输入了其中一个命名范围,或者您遇到了 PDF 构建器不喜欢的某种限制。
另外,请尝试共产国际的建议,包括OpenAfterPublish:=False
。额外的好处是,你只需要把它放在 1 个地方就可以更改全部你的代码!