☰

MS Excel VBA zum Exportieren in PDF wird plötzlich beendet und zwingt den Computer zum Neustart

tag-icon • tag-icon microsoft-excel vba
MS Excel VBA zum Exportieren in PDF wird plötzlich beendet und zwingt den Computer zum Neustart

Ich habe VBA-Code (siehe unten), der im Grunde benannte Bereiche in einer Excel-Datei in PDF druckt. Ich habe Befehlsschaltflächen für jedes Makro und es funktioniert einwandfrei, aber wenn ich sie nacheinander drucke (Gruppe1, Gruppe2, Gruppe3...), wird die Datei plötzlich geschlossen, wenn ich zu Gruppe6 komme, und der Computer muss neu gestartet werden???

was mache ich falsch? Jede Hilfe wird sehr geschätzt.

Danke

Cris

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

Antwort1

Dies wird Ihr Problem wahrscheinlich nicht lösen, aber es wird Ihren Codevielwartungsfreundlicher.

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

Nun steht Ihnen eine Prozedur zur Verfügung, die Sie zum Erstellen mehrerer PDFs aufrufen können:

Public Sub PrintReports()
  PrintReportGroup 3, 1, 16
  PrintReportGroup 4, 17, 28
  PrintReportGroup 5, 29, 45
  PrintReportGroup 6, 46, 67
  'etc...
End Sub

Es erleichtert auch das Debuggen, indem die PrintReportGroup 6, 46 67Zeile geändert wird. Ändern Sie das in

PrintReportGroup 6, 46, 46

und sehen Sie, ob es funktioniert. Wenn ja, ändern Sie es in

PrintReportGroup 6, 46, 47

und weitermachen, bis es explodiert. Ich vermute, dassentwederEs fehlt ein benannter Bereich, oder Sie haben einen der benannten Bereiche falsch eingegeben, oder Sie stoßen im PDF-Builder auf eine Art Beschränkung, die ihm nicht gefällt.

Versuchen Sie auch den Vorschlag der Komintern, einzuschließen OpenAfterPublish:=False. Zusätzlicher Bonus: Sie müssen es nur an einer Stelle einfügen, um es zu ändernalledein Code!

verwandte Informationen