Excel VBA Print Freezes

Question

Я пробовал множество решений и просматривал веб-чат больше часов. Может быть, один из вас может помочь.

У меня есть макрос, который выбирает все листы с определенной строкой в ​​их имени, а затем печатает их. Если слишком много листов, оно зависает, и вы не можете разбить макрос для отладки, а Ctrl + Alt + Del - единственный выход. Замерзает в разных местах, каждый раз тоже ...

Мой исходный код:

Application.ScreenUpdating = False 
Application.EnableEvents = False 
Dim x As Integer 
For x = 1 To Worksheets.count 
    If VBA.InStr(Worksheets(x).Name, "Lateral Assessment") > 0 Then 
     With Worksheets(x).PageSetup 
      .Orientation = xlPortrait 
      .Zoom = False 
      .FitToPagesWide = 1 
      .FitToPagesTall = 1 
     End With 
     Worksheets(x).PrintOut 
    End If 
Next x 
Application.ScreenUpdating = True 
Application.EnableEvents = True 

Я пытался, в других темах форума, следующее:

• Добавление DoEvents в цикле для позволяют системному времени обрабатывать
• Добавление таймера «Подождите», чтобы дать ему время для обработки
• Сначала прокрутка и настройка свойств страниц, а затем печать (он заканчивает цикл, чтобы установить количество страниц в сети, но замерзает в контуре печати, например «normal»
• Перемещено для добавления всех листов в массив, а затем отправки их как отдельного задания на печать (оно все еще зависает после 14-16 страницы)

Я также в какой-то момент добавил индикатор выполнения, который я использую во многих моих больших процессах, и вы можете видеть, как он прогрессирует по счету перед замораживанием на несогласованном листе. Кроме того, обратите внимание, что проблема возникает, даже если я запускаю ее за одну итерацию за раз из окна кода VBA, поэтому представляется, что она не связана с временем обработки (хотя нельзя быть уверенным в этом).

Мой текущий код:

Application.ScreenUpdating = False 
Application.EnableEvents = False 
Dim x As Long, iTotal As Long, sSheets() As String 
iTotal = -1 
For x = 1 To Worksheets.count 
    If VBA.InStr(Worksheets(x).Name, "Lateral Assessment") > 0 Then 
     With Worksheets(x).PageSetup 
      .Orientation = xlPortrait 
      .Zoom = False 
      .FitToPagesWide = 1 
      .FitToPagesTall = 1 
     End With 
     iTotal = iTotal + 1 
     ReDim Preserve sSheets(iTotal) 
     sSheets(iTotal) = Worksheets(x).Name 
    End If 
Next x 

If iTotal <> -1 Then 
    Sheets(sSheets).PrintOut Copies:=1, Collate:=True 
End If 

Application.ScreenUpdating = True 
Application.EnableEvents = True 

Любая идея, почему это происходит, и возможные решения, которые я попытался нету?

Answer 1

Убедитесь, что включено ScreenUpdating. Код VBA: Application.ScreenUpdating = True

Если он висит, это работает. Измените размер окна printpreview (возьмите угол или край и сделайте его маленьким, затем большим). Это, похоже, заставляет Excel ударить в ScreenUpdating и дает вам контроль. На всяком случае, так что вы всегда имеете доступ к краям окна, чтобы сделать это, вы можете автоматически изменить размер Excel непосредственно перед PrintPreview с:

Sub WindowState_850x1400() 
    With Application 
    .WindowState = xlNormal 
    .Top = 1 
    .Left = 1 
    .Height = 850 
    .Width = 1400 
    End With 
End Sub