Excel VBA Print Freezes - excel

Question

I've tried tons of solutions and browsed the web for more for hours now. Maybe one of you can help.
I have a macro that selects all sheets with a specific string in their name, then prints them. If there are too many sheets, it freezes, and you are unabled to break the macro to debug, and Ctrl+Alt+Del is the only way out. It freezes at different locations each time too...
My original code:
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
I have tried, per other forum threads, the following:
Adding DoEvents in the loop to allow the system time to process
Adding a "Wait" timer to give it time to process
Looping through and setting the pagesetup properties first, then printing (it finishes the loop to set pagesetups fine, but freezes in the print loop like "normal"
Moved to adding all of the sheets to an array, then sending them as a single print job (it still freezes after 14-16 pages)
I also at one point added a progress bar I use in a lot of my bigger processes, and you can see it progressing through the count before freezing on an inconsistent sheet number. Additionally, note that the problem occurs even if I run it one iteration at a time from the VBA code window, thus, it appears that it is not related to processing time (although one cannot be certain of that).
My current code:
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
Any idea why this is happening, and possible solutions that I havent tried?

Answer 1

Make sure ScreenUpdating is on. The VBA code is:
Application.ScreenUpdating = True
If it does hang, this works. Resize the printpreview window (grab the corner or edge and make it small then large again). This seems to cause Excel to kick into ScreenUpdating and gives you control back. Just in case, so you always have access to the edges of the window to do this, you can automatically resize Excel just before the printpreview with:
Sub WindowState_850x1400()
With Application
.WindowState = xlNormal
.Top = 1
.Left = 1
.Height = 850
.Width = 1400
End With
End Sub