MS Excel VBA для экспорта в PDF внезапно завершает работу и заставляет компьютер перезагрузиться

Question

У меня есть некоторый код VBA (см. Ниже), который в основном печатает именованные диапазоны в файле Excel в PDF. У меня есть командные кнопки для каждого макроса, и он работает нормально, но когда я печатаю их последовательно, вы (group1, group2, group3 ....), когда я попадаю в group6, файл просто внезапно закрывается и заставляет компьютер перезагружаться ???

Что я делаю неправильно? Любая помощь будет высоко оценена.

Спасибо

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

score 0 · Answer 1 · 2011-03-09T19:38:42

Это , вероятно , не решит вашу проблему, но это сделает ваш код намного более ремонтопригодно.

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 место, чтобы изменить весь свой код!

Сейчас выбран русский

MS Excel VBA для экспорта в PDF внезапно завершает работу и заставляет компьютер перезагрузиться

1 ответ1

Всё ещё ищете ответ? Посмотрите другие вопросы с метками microsoft-excel vba.

MS Excel VBA для экспорта в PDF внезапно завершает работу и заставляет компьютер перезагрузиться

1 ответ1

Всё ещё ищете ответ? Посмотрите другие вопросы с метками microsoft-excel vba.

Похожие