Find out Pagebreak width and height on sheet

Roderick_E

Well-known Member
Joined
Oct 13, 2007
Messages
2,051
I'm trying to fit some charts within a pagebreak. I've done it manually and it works fine but now I've found users changing the width of columns and rows (I don't want to protect sheet), so it mess up my manual settings. I'd like to determine the width and height of the first pagebreak (all the rest are same).

Sample of what I'm currently doing:

Code:
baseleft = 232
basewidth = 450 'halfway
baseheight = 274 'halfway
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Height = baseheight * 2

Would be great if the
  • baseleft was determined by left edge of pagebreak.
  • basewidth was determined by left edge of entire sheet + middle of pagebreak (halway horizontal)
  • baseheight was determined by top of pagebreak to middle of pagebreak (halfway verticle)

Any ideas how to accomplish? Thanks
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

MartyS

Board Regular
Joined
Feb 12, 2018
Messages
197
I'm trying to fit some charts within a pagebreak.


Would be great if the
  • baseleft was determined by left edge of pagebreak.
  • basewidth was determined by left edge of entire sheet + middle of pagebreak (halway horizontal)
  • baseheight was determined by top of pagebreak to middle of pagebreak (halfway verticle)

Any ideas how to accomplish? Thanks



With the following, you can place a chart either in a defined RANGE or within the PAGE BREAK found to the right of and to the bottom of cell A1

For the Range, use: PlaceChartInRange()

For the PageBreaks, use: PlaceChartFull() or PlaceChartTopHalf() or PlaceChartBottomHalf()

Code:
Sub PlaceChartFull()
    PlaceChartInPageBreaks "Full"
End Sub


Sub PlaceChartTopHalf()
    PlaceChartInPageBreaks "TopHalf"
End Sub


Sub PlaceChartBottomHalf()
    PlaceChartInPageBreaks "BottomHalf"
End Sub




Sub PlaceChartInPageBreaks(ByVal PlacementInBreak As String)

    Dim FarRightPB As String, FarDownPB As String
    Dim TopLeftCell As String, BottomRightCell As String
    
    FarDownPB = FindFirstPageBreak("VerticalDown")
    FarRightPB = FindFirstPageBreak("HorizontalAcross")

    TopLeftCell = "A1"
    BottomRightCell = Cells(Range(FarDownPB).Row, Range(FarRightPB).Column).Address
        
    ResizeAndPlaceChart TopLeftCell, BottomRightCell, PlacementInBreak

End Sub




Sub PlaceChartInRange()

    Const TopLeftCell = "B5"
    Const BottomRightCell = "H28"
    
    ResizeAndPlaceChart TopLeftCell, BottomRightCell, "Full"
    
End Sub


Function FindFirstPageBreak(ByVal Direction As String) As String

    Const MaxCellsToCheck = 100
    Dim Cntr As Integer
    Dim BreakFound As Boolean


    BreakFound = False
    
    Select Case Direction
    
        Case "VerticalDown"
            
            For Cntr = 1 To MaxCellsToCheck
                With Sheets("Sheet1").Rows(Cntr)
                    If .PageBreak <> xlNone Then
                        FindFirstPageBreak = Cells(Cntr, 1).Address
                        Exit For
                    End If
                End With
            Next Cntr
        
        Case "HorizontalAcross"
    
            For Cntr = 1 To MaxCellsToCheck
                With Sheets("Sheet1").Columns(Cntr)
                    If .PageBreak <> xlNone Then
                        FindFirstPageBreak = Cells(1, Cntr).Address
                        Exit For
                    End If
                End With
            Next Cntr
    
    End Select

End Function



Sub ResizeAndPlaceChart(ByVal TopLeftCell As String, ByVal BottomRightCell As String, ByVal PlacementInBreak As String)

    Dim StartRow As Integer, StartCol As Integer, EndRow As Integer, EndCol As Integer
    Dim BaseLeft As Single, BaseTop As Single, BaseHeight As Single, BaseWidth As Single
    
    StartRow = Range(TopLeftCell).Row
    StartCol = Range(TopLeftCell).Column
    EndRow = Range(BottomRightCell).Row
    EndCol = Range(BottomRightCell).Column
    
    If StartCol = 1 Then
        BaseLeft = GetRangeWidth(Cells(StartRow, 1).Address & ":" & Cells(StartRow, StartCol).Address) - GetRangeWidth("A1")
        BaseWidth = GetRangeWidth(Cells(1, StartCol).Address & ":" & Cells(1, EndCol - 1).Address)
      Else
        BaseLeft = GetRangeWidth(Cells(StartRow, 1).Address & ":" & Cells(StartRow, StartCol - 1).Address)
        BaseWidth = GetRangeWidth(Cells(1, StartCol).Address & ":" & Cells(1, EndCol).Address)
    End If
    
    If StartRow = 1 Then
        BaseTop = GetRangeHeight(Cells(1, StartCol).Address & ":" & Cells(StartRow, EndCol).Address) - GetRangeHeight("A1")
        BaseHeight = GetRangeHeight(Cells(StartRow, StartCol).Address & ":" & Cells(EndRow - 1, StartCol).Address)
      Else
        BaseTop = GetRangeHeight(Cells(1, StartCol).Address & ":" & Cells(StartRow - 1, EndCol).Address)
        BaseHeight = GetRangeHeight(Cells(StartRow, StartCol).Address & ":" & Cells(EndRow, StartCol).Address)
    End If
    
    Select Case PlacementInBreak
        
        Case "TopHalf"
            BaseHeight = BaseHeight / 2
        
        Case "BottomHalf"
            BaseHeight = BaseHeight / 2
            BaseTop = BaseHeight
        
        Case Else
        
        
    End Select
        
    With ActiveSheet.ChartObjects("Chart 1")
        .Left = BaseLeft
        .Top = BaseTop
        .Width = BaseWidth
        .Height = BaseHeight
    End With


End Sub




Function GetRangeHeight(ByVal rng As String) As Single

    With Sheets("Sheet1").Range(rng)
        GetRangeHeight = .Height
    End With
 
End Function




Function GetRangeWidth(ByVal rng As String) As Single

    With Sheets("Sheet1").Range(rng)
        GetRangeWidth = .Width
    End With
 
End Function




You can, of course, alter the code to get the chart to be a certain size/dimensions within the pagebreaks, now they're available.

Here's an example: https://www.dropbox.com/s/tbh0xynwd7zgr2v/PlaceChart.xlsm?dl=0
 
Upvote 0

Forum statistics

Threads
1,186,732
Messages
5,959,432
Members
438,424
Latest member
TheHank

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
Top