VBA Print Area/Page Breaks - Doing my head in

ClimoC

Well-known Member
Joined
Aug 21, 2009
Messages
584
Anyone had to deal with this before?

So I want to be able to print my Document in various formats.

In a Userform are two option, one to print 1 page high x #of pages wide (as required), then other to split it at x-row (which is dynamic based on the formatting of the sheet)

The following code seems to work perfectly for setting the Print Range and appropriately setting Page Breaks within that Print Range.

BUT, when I go to print Preview, it has taken each 'page' set by the page break, and shrunk it to about 1/10th of the size of the page. In actual fact, it should roughly fit the size of an A3 in Landscape.

I've tried all day messing with the 'FittopagesTall = false', 'zoom=false' and other things but must have something wrong somewhere. Can anyone help?

Thanks
C

Rich (BB code):
Private Sub CommandButton1_Click()

If Me.OptionButton1.Value = False And Me.OptionButton2.Value = False Then
        Beep
        MsgBox "Please Select a Print Area Option"
        Exit Sub
End If


Dim ss As Worksheet, GridRngz As Range
Set ss = Thisworkbook.Sheets("GridData")
Set GridRngz = Union(Range(ss.Range("B23").Value), Range(ss.Range("B24").Value), Range(ss.Range("B25").Value), Range(ss.Range("B26").Value), _
                                                Range(ss.Range("B27").Value), Range(ss.Range("B28").Value), Range(ss.Range("B29").Value))
                                                
'Format certain unused areas, increase fonts for printing, etc
GridRngz.Font.Size = 12

Rows(ss.Range("B9").Value + 1 & ":" & ss.Range("B9").Value + 3).RowHeight = 0
Rows(ss.Range("B11").Value + 1 & ":" & ss.Range("B11").Value + 3).RowHeight = 0
Rows(ss.Range("B13").Value + 1 & ":" & ss.Range("B13").Value + 3).RowHeight = 0
Rows(ss.Range("B15").Value + 1 & ":" & ss.Range("B15").Value + 3).RowHeight = 0
Rows(ss.Range("B17").Value + 1 & ":" & ss.Range("B17").Value + 3).RowHeight = 0
Rows(ss.Range("B19").Value + 1 & ":" & ss.Range("B19").Value + 3).RowHeight = 0
Rows(ss.Range("B21").Value + 1 & ":" & ss.Range("B21").Value + 3).RowHeight = 0
Dim MyUsedRng As Range, RPTDONE As Boolean, rpt As Integer

'xx & yy are the Overall width and length of the whole sheet
xx = ss.Range("B7").Value
yy = ss.Range("B21").Value + 1

'Doc starts printing from row 86, to the bottom right corner
Set MyUsedRng = Range(Cells(86, 1).AddressLocal & ":" & Cells(yy, xx).AddressLocal)


'Setting print options. Had tried with all the bits that the macro recorder made, no better or different
    Application.PrintCommunication = True
    Thisworkbook.Sheets("ForwardPlan").PageSetup.PrintArea = MyUsedRng.Address
    Application.PrintCommunication = False
    With Thisworkbook.Sheets("ForwardPlan").PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    Thisworkbook.Sheets("ForwardPlan").PageSetup.PrintArea = MyUsedRng.Address

    Application.CellDragAndDrop = True
    Application.PrintCommunication = False
    
    If Not Thisworkbook.Sheets("ForwardPlan").VPageBreaks.Count = 0 Then
    For i = 1 To Thisworkbook.Sheets("ForwardPlan").VPageBreaks.Count
            If Not Thisworkbook.Sheets("ForwardPlan").VPageBreaks.Count = 0 Then
                Thisworkbook.Sheets("ForwardPlan").VPageBreaks(i).DragOff xlToRight, 1
            Else
                Exit For
            End If
    Next
    End If
    
'So, Option1 is to have 6 months (1week = 1 column) x the overall height per page, for as wide as the doc is (dynamic)
Select Case True
        Case Me.OptionButton1.Value = True
                        RPTDONE = False
                        rpt = 0
                Thisworkbook.Sheets("ForwardPlan").HPageBreaks.Add Before:=Thisworkbook.Sheets("ForwardPlan").Cells(ss.Range("B21").Value + 1, 1)
                Do Until RPTDONE = True
                                    rpt = rpt + 26
                                    Thisworkbook.Sheets("ForwardPlan").VPageBreaks.Add Before:=MyUsedRng.Cells(1, rpt)
                                    If rpt >= (ss.Range("B7").Value - 26) Then RPTDONE = True
                Loop
                
'Option 2, is to do it in 4month chunks, with a vertical split about 4/7ths of the way down. The number of cells '4/7ths' IS, is dynamic
        Case Me.OptionButton2.Value = True
                RPTDONE = False
                rpt = 0
                Thisworkbook.Sheets("ForwardPlan").HPageBreaks.Add Before:=Thisworkbook.Sheets("ForwardPlan").Cells(ss.Range("B15").Value + 1, 1)
                Do Until RPTDONE = True
                                    rpt = rpt + 20
                                    Thisworkbook.Sheets("ForwardPlan").VPageBreaks.Add Before:=MyUsedRng.Cells(1, rpt)
                                    If rpt >= (ss.Range("B7").Value - 20) Then RPTDONE = True
                Loop
End Select

Application.PrintCommunication = True

End Sub
 
Last edited:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Don't know if it's worth mentioning, but when I told it not to print the comments, it always defaulted back to turning on 'Print Comments at end of the sheet'. There's a lot of comments, we don't want them printed!
 
Upvote 0

Forum statistics

Threads
1,215,368
Messages
6,124,521
Members
449,169
Latest member
mm424

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top