Find out Pagebreak width and height on sheet

[Roderick_E]

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:

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

 

[MartyS]

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()

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