Jtdylktuy

I have some VBA code (see below) that basically prints named ranges in an excel file to PDF.
I have command buttons for each macro and It works fine, but when i'm printing them sequentially you (group1, group2, group3....) when i get to group6
the file just suddenly closes and forces the computer to restart???

what am i doing wrong? Any help will be highly appreciated.

Thanks

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 & "MyReportsPDF_ReportsGroup1.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 & "MyReportsPDF_ReportsGroup2.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 & "MyReportsPDF_ReportsGroup3.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 & "MyReportsPDF_ReportsGroup4.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 & "MyReportsPDF_ReportsGroup5.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 & "MyReportsPDF_ReportsGroup6.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 & "MyReportsPDF_ReportsGroup7.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 & "MyReportsPDF_ReportsGroup8.pdf", Quality:=xlQualityStandard, _

    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True



Worksheets("Index").Activate

ActiveWorkbook.Save

MsgBox "Done!", vbOKOnly



End Sub

This probably won't solve your problem, but it will make your code much more maintainable.

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 & "MyReportsPDF_ReportsGroup" & 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

Now you have one procedure that you can call to make several PDFs:

Public Sub PrintReports()

  PrintReportGroup 3, 1, 16

  PrintReportGroup 4, 17, 28

  PrintReportGroup 5, 29, 45

  PrintReportGroup 6, 46, 67

  'etc...

End Sub

It also makes it easy to debug by modifying the PrintReportGroup 6, 46 67 line. Change that to

PrintReportGroup 6, 46, 46

and see if it works. If so, change it to

PrintReportGroup 6, 46, 47

and keep going until it blows up. I'm guessing that either there's a missing named range, or you typed one of the named ranges incorrectly, or you're hitting some sort of limit in the PDF builder that it doesn't like.

Also, try Comintern's suggestion of including OpenAfterPublish:=False. Added bonus, you'll only have to put it in 1 place to change all your code!