pbornemeier
Well-known Member
- Joined
- May 24, 2005
- Messages
- 3,915
I need to ensure that column 24 is the last column on page one of my worksheet. Some of the column 1-24 content varies so that the automatic page break will sometimes occur at columns 21-24. To correct this I use the following code to reduce the PageSetup.Zoom factor until the automatic vertical page break occurs at column 25.
Unfortunately the position of the page breaks are not recalculated until a Print Preview is performed. As far as I can tell when this is done, any code execution is halted until the Print Preview is closed.
The following code contains some the of the workarounds that I tried. Does anyone know how to force pagebreak recalculation in VBA without needing to trigger a Print Preview?
Using Excel 2010.
Unfortunately the position of the page breaks are not recalculated until a Print Preview is performed. As far as I can tell when this is done, any code execution is halted until the Print Preview is closed.
The following code contains some the of the workarounds that I tried. Does anyone know how to force pagebreak recalculation in VBA without needing to trigger a Print Preview?
Using Excel 2010.
Code:
Sub SetVPgBreakToCol25()
'If the last column on the first sheet is not column 24,
'Incrementally reduce ActiveSheet.PageSetup.Zoom until it is
'Excel 2010 PROBLEM: Page breaks do not recalculate until Print Preview is done
Dim lCount
Dim lVPgBrkMinCol As Long
Dim lVPgBrkCol As Long
ActiveSheet.PageSetup.Zoom = 100
ActiveSheet.VPageBreaks(1).Location = Range("Y1") 'Desired location
'Find first break
lVPgBrkMinCol = 1000
If ActiveSheet.VPageBreaks.Count > 0 Then
For lCount = 1 To ActiveSheet.VPageBreaks.Count
lVPgBrkCol = ActiveSheet.VPageBreaks(lCount).Location.Column
If lVPgBrkCol < lVPgBrkMinCol Then lVPgBrkMinCol = lVPgBrkCol
Next
End If
If lVPgBrkMinCol < 25 Then
'The msgbox is uncommented if ActiveWindow.SelectedSheets.PrintPreview stmt is uncommented
MsgBox "The Print Preview screen will display a few times while the print zoom" & vbLf & _
"is adjusted to make the PS column appear at the right end of the first" & vbLf & _
"worksheet. " & vbLf & vbLf & _
"Click the 'Close Print Preview' button repeatedly until the zoom is correctly adjusted.", , "Semi-AutoAdjust Print Zoom"
'Shrink print zoom till break occurs at column 25
Do While ActiveSheet.VPageBreaks(1).Location.Column < 25
With ActiveSheet.PageSetup
.Zoom = .Zoom - 2
'June 2007 post at http://www.excelbanter.com/showthread.php?t=147373
'Said the following worked. It does not work in Excel 2010.
'.PaperSize = .PaperSize
End With
DoEvents 'makes no difference
'Thought togggling this might help
'ActiveSheet.DisplayPageBreaks = False
'ActiveSheet.DisplayPageBreaks = True
'DoEvents
'Toggling among views did not appear force recalc
'ActiveWindow.View = xlPageLayoutView
'ActiveWindow.View = xlNormalView
'ActiveWindow.View = xlPageBreakPreview
'Following used with msgbox above. Works, but requires manual intervention to conclude
'It forces recalc, but pauses code execution until 'Close Print Preview' is clicked
ActiveWindow.SelectedSheets.PrintPreview
If ActiveSheet.PageSetup.Zoom < 75 Then
'To force end of shrinkage
MsgBox "Page Setup Zoom is set to 75 - shrinkage stopped", , ""
Exit Do
End If
Loop
End If
End Sub