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

729
Cliff

У меня есть некоторый код 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
0
Я предполагаю, что процесс создания PDF занимает память, а следующий начинается до того, как предыдущий будет завершен. Вам нужно будет подождать или сделать события, чтобы замедлить код, чтобы ждать каждого PDF-файла, который будет создан перед запуском следующего кода. Scott Craner 7 лет назад 0
@ScottCraner - есть вызов `MsgBox ()` в конце каждого `Sub`. Если процесс действительно не медленен (экономия через сеть жестяных банок и шпагата в северной Сибири), он должен быть завершен к тому времени, когда пользователь нажал кнопку ОК. Плюс, это VBA `.ExportAsFixedFormat` не будет работать в фоновом потоке, не так ли? Черт, ручное нажатие кнопки «Сохранить» заблокирует VBE во время сохранения файла ... FreeMan 7 лет назад 1
@FreeMan завершается к тому времени, когда возвращается метод `.Save` и даже отображается` MsgBox` Mathieu Guindon 7 лет назад 0
Ну, я сказал, что это было предположение. :) Scott Craner 7 лет назад 0
Вы пробовали это с `OpenAfterPublish: = False`? Это помогло бы определить, является ли это проблемой Excel или проблемой чтения PDF. Comintern 7 лет назад 0

1 ответ на вопрос

0
FreeMan

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

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

Похожие вопросы