☰

MS Excel VBA para exportar para PDF termina repentinamente e força a reinicialização do computador

tag-icon • tag-icon microsoft-excel vba
MS Excel VBA para exportar para PDF termina repentinamente e força a reinicialização do computador

Eu tenho um código VBA (veja abaixo) que basicamente imprime intervalos nomeados em um arquivo Excel em PDF. Eu tenho botões de comando para cada macro e funciona bem, mas quando estou imprimindo-os sequencialmente você (grupo1, grupo2, grupo3....) quando chego ao grupo6 o arquivo fecha de repente e força o computador a reiniciar? ?

O que estou fazendo de errado? Qualquer ajuda será muito apreciada.

Obrigado

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

Responder1

Isso provavelmente não resolverá seu problema, mas tornará seu códigomuitomais sustentável.

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

Agora você tem um procedimento que pode chamar para criar vários PDFs:

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

Também facilita a depuração modificando a PrintReportGroup 6, 46 67linha. Mude isso para

PrintReportGroup 6, 46, 46

e veja se funciona. Se sim, altere para

PrintReportGroup 6, 46, 47

e continue até explodir. Eu estou supondo quequalquerhá um intervalo nomeado faltando, ou você digitou um dos intervalos nomeados incorretamente, ou está atingindo algum tipo de limite no construtor de PDF que ele não gosta.

Além disso, tente a sugestão do Comintern de incluir OpenAfterPublish:=False. Bônus adicionado, você só terá que colocá-lo em um lugar para mudartodosseu código!

informação relacionada