VBA Coding Help

Padawan018

Board Regular
Joined
Sep 29, 2006
Messages
63
Hi,

I have a pivot table that has data for years 2007 and 2008. I want set the print area to capture the entire pivot table and set a horizontal page break between the 2007 and 2008 data.

Here is my code but it doesn't seem to be setting the Horizontal Page Break.

Code:
Sub printmenu()

Dim PrintRange 
Dim Page2Break

    ans = MsgBox("Your printer is currently defaulted to " & vbNewLine & vbNewLine & _
        Application.ActivePrinter & vbNewLine & vbNewLine & _
        "To select another printer, go to FILE in the Menu Bar, select PRINT." & vbNewLine & _
        "Do you want to print this sheet? ", vbYesNo + vbQuestion, Title:="Printer Select")
    If ans = vbNo Then Exit Sub
    
    LastRow = Range("B65536").End(xlUp).Row
    Range("B7").End(xlDown).Select
    Selection.End(xlDown).Select
    
Set Page2Break = ActiveCell.Offset(0, -1)
    PrintRange = Range("B7", Cells(LastRow, "K")).Address

    ActiveSheet.ResetAllPageBreaks
    ActiveSheet.PageSetup.Printarea = Cells.Address
    

    With ActiveSheet.PageSetup
        .PrintTitleRows = "$7:$7"
        .Orientation = xlLandscape
        .Printarea = PrintRange
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Page2Break
    
    Sheet7.PrintOut
End Sub


The Layout for the Pivot Table is :
Year - Title - Group | Data

Thanks in Advance for your help,
Padawan018
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
I have changed the code a little bit but I am still getting an error. Anybody know how to set horizontal pagebreaks in VBA.

See code below:

Code:
Sub printmenu()

Dim PrintRange
Dim Page2Break

    ans = MsgBox("Your printer is currently defaulted to " & vbNewLine & vbNewLine & _
        Application.ActivePrinter & vbNewLine & vbNewLine & _
        "To select another printer, go to FILE in the Menu Bar, select PRINT." & vbNewLine & _
        "Do you want to print this sheet? ", vbYesNo + vbQuestion, Title:="Printer Select")
    If ans = vbNo Then Exit Sub
    
    Application.ScreenUpdating = False
    
    LastRow = Range("B65536").End(xlUp).Row
    Range("B7").End(xlDown).Select
    Selection.End(xlDown).Select
    Set Page2Break = ActiveCell
    Set PrintRange = Range("B7", Cells(LastRow, "K"))
    
    ActiveSheet.Cells.PageBreak = xlPageBreakNone ' ResetAllPageBreaks
    ActiveSheet.PageSetup.Printarea = Cells.Address
    
    
    
'    Set Page2Break = ActiveCell.Offset(0, -1)
'    Set PrintRange = Range("B7", Cells(LastRow, "K"))
    
    Set PrintRange = Range("B7", Cells(LastRow, "K"))
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$7:$7"
        .Orientation = xlLandscape
        .Printarea = PrintRange.Address
        .FitToPagesWide = 1

    End With
    
'    ActiveSheet.HPageBreaks.Add Before:=Page2Break
    
    'Count only horizontal page breaks and pass to an Integer
    iPBcount = ActiveSheet.HPageBreaks.Count
    If iPBcount >= 2 Then
        For i = 1 To iPBcount
            'Set variable 1 to page break X
            Set rCell1 = ActiveSheet.HPageBreaks(i).Location
                rCell1.Select
                If rCell1.Address <> Page2Break.Address Then 'is not the FY page break
                    Set rCell1 = Page2Break
                    Set ActiveSheet.HPageBreaks(i).Address = rCell1.Address
                End If
            Set rCell1 = Nothing
        Next i
    End If

'    ActiveWindow.SelectedSheets
    
    Sheet7.PrintOut
    
End Sub
 
Upvote 0
I am getting an object required on the line

Code:
set activesheet.hpagebreaks(i).location = rCell1.address

Any help would be greatly appreciated. I have been trying to figure this out for some time.

Thanks,
Padawan018
 
Upvote 0
Thanks that worked. Now I want to delete any pagebreaks that are in between the set page breaks. In the end I should have two pages, First will have just FY08 Data and the second will just have FY09.

Code:
iPBcount = ActiveSheet.HPageBreaks.Count
    If iPBcount >= 2 Then
        For i = 1 To iPBcount
            'Set variable 1 to page break X
            Set rCell1 = ActiveSheet.HPageBreaks(i).Location
                
                ActiveSheet.HPageBreaks.Add before:=Page2Break
                
                If rCell1.Address <> Page2Break.Address Then _ 
                       ActiveSheet.HPageBreaks(i).Delete 'is not the FY page break

            Set rCell1 = Nothing
        Next i
End If


when I get to the delete line, I get the Application defined or Object-defined error.

Thanks,
Padawan018
 
Upvote 0
I was able to find a work around.


Code:
Sub printmenu()

Dim PrintRange
Dim Page2Break

    ans = MsgBox("Your printer is currently defaulted to " & vbNewLine & vbNewLine & _
        Application.ActivePrinter & vbNewLine & vbNewLine & _
        "To select another printer, go to FILE in the Menu Bar, select PRINT." & vbNewLine & _
        "Do you want to print this sheet? ", vbYesNo + vbQuestion, Title:="Printer Select")
    If ans = vbNo Then Exit Sub
    
    Application.ScreenUpdating = False
    
    LastRow = Range("B65536").End(xlUp).Row
    
    Range("B7").End(xlDown).Select
    Selection.End(xlDown).Select
    Set Page2Break = ActiveCell
    
    Set PrintRange1 = Range("B7", Cells(Page2Break.Row - 1, "K"))
    Set PrintRange2 = Range(Page2Break, Cells(LastRow, "K"))

'Reset Page Breaks
    ActiveSheet.Cells.PageBreak = xlPageBreakNone ' ResetAllPageBreaks
    ActiveSheet.PageSetup.Printarea = Cells.Address

'Print Page 1
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$7:$7"
        .Orientation = xlLandscape
        .Printarea = PrintRange1.Address
    End With
    
    Sheet7.PrintOut

'Print Page 2    
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$7:$7"
        .Orientation = xlLandscape
        .Printarea = PrintRange2.Address
    End With
    
    Sheet7.PrintOut

'Reset Page Breaks    
    ActiveSheet.Cells.PageBreak = xlPageBreakNone ' ResetAllPageBreaks
    ActiveSheet.PageSetup.Printarea = Cells.Address

end sub

Thanks for the help. I would still like to know how to delete a pagebreak.

Padawan018
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,920
Members
448,533
Latest member
thietbibeboiwasaco

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