☰

PDF にエクスポートする MS Excel VBA が突然終了し、コンピューターを強制的に再起動する

tag-icon • tag-icon microsoft-excel vba
PDF にエクスポートする MS Excel VBA が突然終了し、コンピューターを強制的に再起動する

基本的に Excel ファイル内の名前付き範囲を PDF に印刷する VBA コード (下記参照) があります。マクロごとにコマンド ボタンがあり、問題なく動作しますが、順番に印刷しているときに (group1、group2、group3...)、group6 に到達すると、ファイルが突然閉じて、コンピューターが強制的に再起動されます。

何が間違っているのでしょうか? どのような助けでも大歓迎です。

ありがとう

クリス

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 を作成するために呼び出すことができる 1 つのプロシージャができました。

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

そして爆発するまで続ける。どちらか名前付き範囲が欠落しているか、名前付き範囲の 1 つを間違って入力しているか、または PDF ビルダーで何らかの制限に達しており、それが適切ではありません。

また、コミンテルンの提案である も試してみてくださいOpenAfterPublish:=False。 1か所に を入れるだけで変更できるので、さらに便利です。全てあなたのコード！

関連情報