Automatic Chart Sizing & Positioning

Roderick_E

Roderick_E

Well-known Member
Joined
Oct 13, 2007
Messages
2,051
So I've got a vba macro to size and position up to 4 pagebreaks of charts. It can handle 1-4 and 6 charts on each pagebreak, sizing and positioning equally.

However, I want to make it more dynamic so I don't have to keep pasting in the configurations for the next pagebreak. Any ideas? Thanks

Code: 
Public Sub Count_Charts_On_Each_Page()


    Dim page As Long
    Dim chartObj As ChartObject
    Dim HPageBreakStartRow As Long
    Dim numChartsOnPage As Long
Dim pagecharts As Variant
ReDim pagecharts(0 To 0)
baseleft = 232
basetop = 4
basemid = 280
basewidth = 450
baseheight = 274
    
    HPageBreakStartRow = 1
    With ActiveWorkbook.ActiveSheet
        For page = 1 To .HPageBreaks.Count
            numChartsOnPage = 0
            'Debug.Print page, HpageBreakStartRow, .HPageBreaks(page).Location.Row
            For Each chartObj In .ChartObjects
                'Debug.Print chartObj.BottomRightCell.Address
                If chartObj.TopLeftCell.Row >= HPageBreakStartRow And chartObj.BottomRightCell.Row < .HPageBreaks(page).Location.Row Then
                    numChartsOnPage = numChartsOnPage + 1
                    'MsgBox chartObj.Name & " is on page " & page
    pagecharts(UBound(pagecharts)) = chartObj.Name & "=" & Right("0" & page, 2)
    ReDim Preserve pagecharts(UBound(pagecharts) + 1) 'Allocate next element
                    
                End If
            Next
            'MsgBox numChartsOnPage & " charts on page " & page
            HPageBreakStartRow = .HPageBreaks(page).Location.Row
        Next
    End With
On Error Resume Next 'instead of checking if array was used
ReDim Preserve pagecharts(LBound(pagecharts) To UBound(pagecharts) - 1)  'Deallocate the last, unused element
Resume Next
For Each element In pagecharts
If InStr(element, "=01") Then
cnt1 = cnt1 + 1
End If
If InStr(element, "=02") Then
cnt2 = cnt2 + 1
End If
If InStr(element, "=03") Then
cnt3 = cnt3 + 1
End If
If InStr(element, "=04") Then
cnt4 = cnt4 + 1
End If
Next




For Each element In pagecharts


'PAGE 1
'1 chart
If Right(element, 3) = "=01" Then
If cnt1 = 1 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight * 2
End If
'2 charts
If cnt1 = 2 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth * 2
If hit1 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
End If
If hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
End If
End If
'3 charts
If cnt1 = 3 And Right(element, 3) = "=01" Then
If hit1 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
End If
If hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
End If
If hit1 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
End If
End If
'4 charts
If cnt1 = 4 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
If hit1 = 0 Or hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
End If
If hit1 = 0 Or hit1 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
End If
If hit1 = 1 Or hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + basewidth + 3
End If
If hit1 = 2 Or hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
End If
End If
'6 charts
If cnt1 = 6 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
If hit1 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
End If
If hit1 = 0 Or hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
End If
If hit1 = 1 Or hit1 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit1 = 2 Or hit1 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit1 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
End If
End If
hit1 = hit1 + 1
End If


'PAGE 2
'1 chart
If Right(element, 3) = "=02" Then
'extended
basetop = 608
basemid = 885
If cnt2 = 1 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight * 2
End If
'2 charts
If cnt2 = 2 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth * 2
If hit2 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
End If
If hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
End If
End If
'3 charts
If cnt2 = 3 And Right(element, 3) = "=02" Then
If hit2 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
End If
If hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
End If
If hit2 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
End If
End If
'4 charts
If cnt2 = 4 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
If hit2 = 0 Or hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
End If
If hit2 = 0 Or hit2 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
End If
If hit2 = 1 Or hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + basewidth + 3
End If
If hit2 = 2 Or hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
End If
End If
'6 charts
If cnt2 = 6 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
If hit2 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
End If
If hit2 = 0 Or hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
End If
If hit2 = 1 Or hit2 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit2 = 2 Or hit2 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit2 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
End If
End If
hit2 = hit2 + 1
End If


'PAGE 3
'1 chart
If Right(element, 3) = "=03" Then
'extended
basetop = 1216
basemid = 1494
If cnt3 = 1 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight * 2
End If
'2 charts
If cnt3 = 2 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth * 2
If hit3 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
End If
If hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
End If
End If
'3 charts
If cnt3 = 3 And Right(element, 3) = "=03" Then
If hit3 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
End If
If hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
End If
If hit3 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
End If
End If
'4 charts
If cnt3 = 4 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
If hit3 = 0 Or hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
End If
If hit3 = 0 Or hit3 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
End If
If hit3 = 1 Or hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + basewidth + 3
End If
If hit3 = 2 Or hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
End If
End If
'6 charts
If cnt3 = 6 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
If hit3 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
End If
If hit3 = 0 Or hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
End If
If hit3 = 1 Or hit3 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit3 = 2 Or hit3 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit3 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
End If
End If
hit3 = hit3 + 1
End If


'PAGE 4
'1 chart
If Right(element, 3) = "=04" Then
'extended
basetop = 1821
basemid = 2098
If cnt4 = 1 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight * 2
End If
'2 charts
If cnt4 = 2 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth * 2
If hit4 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
End If
If hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
End If
End If
'3 charts
If cnt4 = 3 And Right(element, 3) = "=04" Then
If hit4 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
End If
If hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
End If
If hit4 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
End If
End If
'4 charts
If cnt4 = 4 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
If hit4 = 0 Or hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
End If
If hit4 = 0 Or hit4 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
End If
If hit4 = 1 Or hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + basewidth + 3
End If
If hit4 = 2 Or hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
End If
End If
'6 charts
If cnt4 = 6 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
If hit4 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
End If
If hit4 = 0 Or hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
End If
If hit4 = 1 Or hit4 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit4 = 2 Or hit4 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit4 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
End If
End If
hit4 = hit4 + 1
End If












Next
MsgBox "Resizing and Repositioning done", vbInformation, "Complete"


End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
I created a single formatting routine, I declared the setting, then before entering the layout module I would pre load the values into the setting and apply in the module, loop for each updated set. I'll see if I can find the old routine so you can see how it works

example
Code: 
    Selection.Type = xlPolynomial
    colourB
    '15
    lineposition = 20
    ActiveSheet.ChartObjects("Chart " & lineposition).Activate
    ActiveChart.Axes(xlValue).AxisTitle.Delete
    ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
    Selection.Caption = "=Dashboard!I" & lineposition
    Selection.Format.TextFrame2.TextRange.Font.Size = 20
    ActiveChart.SetElement (msoElementChartTitleCenteredOverlay)
    Selection.Caption = "=Dashboard!C" & lineposition

    Selection.Format.TextFrame2.TextRange.Font.Size = 20
    ActiveChart.Axes(xlValue).Select
    ActiveChart.Axes(xlValue).TickLabels.Font.Size = 16
    ActiveChart.Axes(xlValue).MaximumScaleIsAuto = True
    ActiveChart.Axes(xlValue).MaximumScale = 1
    ActiveChart.Axes(xlValue).MinimumScale = 0.4
    ActiveChart.DataTable.Format.TextFrame2.TextRange.Font.Size = 12
    ActiveChart.SeriesCollection(2).Trendlines(1).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 2
        .ForeColor.ObjectThemeColor = msoThemeColorAccent3
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
        .BeginArrowheadStyle = msoArrowheadDiamond
        .EndArrowheadStyle = msoArrowheadDiamond
    End With
**************************

Sub ChangeGraphseffective()
    Sheets("graphs effective").Select
    Dim n, charta

    On Error Resume Next
    For n = 19 To 57
        charta = n
        ActiveSheet.ChartObjects("Chart " & n).Select
        ActiveSheet.ChartObjects("Chart " & n).Activate
        ActiveChart.SeriesCollection(1).Select
        Selection.Formula = _
        "=SERIES(GraphData!M1,Dashboard!AA1:AL1,Dashboard!O" & n & ":Z" & n & ",1)"
        'Selection.Formula = _
         "=SERIES(GraphData!R1C13,Dashboard!R1C27:R1C38,Dashboard!R5C15:R5C26,1)"
        ActiveChart.SeriesCollection(2).Select
        Selection.Formula = _
        "=SERIES(GraphData!Y1,Dashboard!AA1:AL1,Dashboard!AA" & n & ":AL" & n & ",2)"
    Next n

    Call MsgBox("Need to adjust targets manually for each chart", vbInformation, "Info")

End Sub

Sub colourB()
'ActiveSheet.ChartObjects("Chart 1").Activate
    Dim ID
    ID = ActiveChart.Name
    ActiveChart.SeriesCollection(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Solid
    End With
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent2
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0.8000000119
        .Transparency = 0
        .Solid
    End With

    ActiveChart.SeriesCollection(2).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent2
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.25
        .Transparency = 0
        .Solid
    End With
 
Last edited:
Upvote 0
mole999 said:
I created a single formatting routine, I declared the setting, then before entering the layout module I would pre load the values into the setting and apply in the module, loop for each updated set. I'll see if I can find the old routine so you can see how it works
Click to expand...

I look forward to seeing it. Here's my version that handles 1-6 charts per pagebreak. I don't care about more than 6 charts on a pagebreak because that gets too busy to see anyhow.
I might be able to get where I need to be if there is a way to count instances in an array. For example, suppose the array looks like this:

{chart1=01 chart2=01 chart3=01 chart4=02 chart5=02 chart6=03 chart7=03 chart8=03}

I want to know how many times =01 appears, which in this case is 3 times.
=02 appears 2 times. =03 appears 3 times.
I was hopeful I could do application.countif(array, "=0" & x) but it doesn't work

Code: 
Public Sub Count_Charts_On_Each_Page()


    Dim page As Long
    Dim chartObj As ChartObject
    Dim HPageBreakStartRow As Long
    Dim numChartsOnPage As Long
Dim pagecharts As Variant
ReDim pagecharts(0 To 0)
baseleft = 232
basetop = 4
basemid = 280
basewidth = 450
baseheight = 274
    
    HPageBreakStartRow = 1
    With ActiveWorkbook.ActiveSheet
        For page = 1 To .HPageBreaks.Count
            numChartsOnPage = 0
            'Debug.Print page, HpageBreakStartRow, .HPageBreaks(page).Location.Row
            For Each chartObj In .ChartObjects
                'Debug.Print chartObj.BottomRightCell.Address
                If chartObj.TopLeftCell.Row >= HPageBreakStartRow And chartObj.BottomRightCell.Row < .HPageBreaks(page).Location.Row Then
                    numChartsOnPage = numChartsOnPage + 1
                    'MsgBox chartObj.Name & " is on page " & page
    pagecharts(UBound(pagecharts)) = chartObj.Name & "=" & Right("0" & page, 2)
    ReDim Preserve pagecharts(UBound(pagecharts) + 1) 'Allocate next element
                    
                End If
            Next
            'MsgBox numChartsOnPage & " charts on page " & page
            HPageBreakStartRow = .HPageBreaks(page).Location.Row
        Next
    End With
On Error Resume Next 'instead of checking if array was used
ReDim Preserve pagecharts(LBound(pagecharts) To UBound(pagecharts) - 1)  'Deallocate the last, unused element
Resume Next
For Each element In pagecharts
If InStr(element, "=01") Then
cnt1 = cnt1 + 1
End If
If InStr(element, "=02") Then
cnt2 = cnt2 + 1
End If
If InStr(element, "=03") Then
cnt3 = cnt3 + 1
End If
If InStr(element, "=04") Then
cnt4 = cnt4 + 1
End If
Next




For Each element In pagecharts


'PAGE 1
'1 chart
If Right(element, 3) = "=01" Then
If cnt1 = 1 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight * 2
End If
'2 charts
If cnt1 = 2 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth * 2
If hit1 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
End If
If hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
End If
End If
'3 charts
If cnt1 = 3 And Right(element, 3) = "=01" Then
If hit1 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
End If
If hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
End If
If hit1 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
End If
End If
'4 charts
If cnt1 = 4 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
If hit1 = 0 Or hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
End If
If hit1 = 0 Or hit1 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
End If
If hit1 = 1 Or hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + basewidth + 3
End If
If hit1 = 2 Or hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
End If
End If
'5 charts
If cnt1 = 5 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
If hit1 = 0 Or hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
End If
If hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + basewidth + 3
End If
If hit1 = 0 Or hit1 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
End If
If hit1 > 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = (basewidth / 3) + 150
End If
If hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit1 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit1 >= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
End If
End If
'6 charts
If cnt1 = 6 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
If hit1 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
End If
If hit1 = 0 Or hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
End If
If hit1 = 1 Or hit1 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit1 = 2 Or hit1 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit1 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
End If
End If
hit1 = hit1 + 1
End If


'PAGE 2
'1 chart
If Right(element, 3) = "=02" Then
'extended
basetop = 608
basemid = 885
If cnt2 = 1 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight * 2
End If
'2 charts
If cnt2 = 2 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth * 2
If hit2 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
End If
If hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
End If
End If
'3 charts
If cnt2 = 3 And Right(element, 3) = "=02" Then
If hit2 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
End If
If hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
End If
If hit2 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
End If
End If
'4 charts
If cnt2 = 4 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
If hit2 = 0 Or hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
End If
If hit2 = 0 Or hit2 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
End If
If hit2 = 1 Or hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + basewidth + 3
End If
If hit2 = 2 Or hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
End If
End If
'5 charts
If cnt2 = 5 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
If hit2 = 0 Or hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
End If
If hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + basewidth + 3
End If
If hit2 = 0 Or hit2 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
End If
If hit2 > 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = (basewidth / 3) + 150
End If
If hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit2 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit2 >= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
End If
End If
'6 charts
If cnt2 = 6 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
If hit2 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
End If
If hit2 = 0 Or hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
End If
If hit2 = 1 Or hit2 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit2 = 2 Or hit2 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit2 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
End If
End If
hit2 = hit2 + 1
End If


'PAGE 3
'1 chart
If Right(element, 3) = "=03" Then
'extended
basetop = 1216
basemid = 1494
If cnt3 = 1 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight * 2
End If
'2 charts
If cnt3 = 2 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth * 2
If hit3 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
End If
If hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
End If
End If
'3 charts
If cnt3 = 3 And Right(element, 3) = "=03" Then
If hit3 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
End If
If hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
End If
If hit3 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
End If
End If
'4 charts
If cnt3 = 4 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
If hit3 = 0 Or hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
End If
If hit3 = 0 Or hit3 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
End If
If hit3 = 1 Or hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + basewidth + 3
End If
If hit3 = 2 Or hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
End If
End If
'5 charts
If cnt3 = 5 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
If hit3 = 0 Or hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
End If
If hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + basewidth + 3
End If
If hit3 = 0 Or hit3 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
End If
If hit3 > 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = (basewidth / 3) + 150
End If
If hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit3 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit3 >= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
End If
End If
'6 charts
If cnt3 = 6 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
If hit3 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
End If
If hit3 = 0 Or hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
End If
If hit3 = 1 Or hit3 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit3 = 2 Or hit3 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit3 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
End If
End If
hit3 = hit3 + 1
End If


'PAGE 4
'1 chart
If Right(element, 3) = "=04" Then
'extended
basetop = 1821
basemid = 2098
If cnt4 = 1 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight * 2
End If
'2 charts
If cnt4 = 2 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth * 2
If hit4 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
End If
If hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
End If
End If
'3 charts
If cnt4 = 3 And Right(element, 3) = "=04" Then
If hit4 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
End If
If hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
End If
If hit4 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
End If
End If
'4 charts
If cnt4 = 4 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
If hit4 = 0 Or hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
End If
If hit4 = 0 Or hit4 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
End If
If hit4 = 1 Or hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + basewidth + 3
End If
If hit4 = 2 Or hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
End If
End If
'5 charts
If cnt4 = 5 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
If hit4 = 0 Or hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
End If
If hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + basewidth + 3
End If
If hit4 = 0 Or hit4 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
End If
If hit4 > 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = (basewidth / 3) + 150
End If
If hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit4 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit4 >= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
End If
End If
'6 charts
If cnt4 = 6 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
If hit4 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
End If
If hit4 = 0 Or hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
End If
If hit4 = 1 Or hit4 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit4 = 2 Or hit4 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit4 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
End If
End If
hit4 = hit4 + 1
End If












Next
MsgBox "Resizing and Repositioning done", vbInformation, "Complete"


End Sub
 
Upvote 0
You are using landscape page orientation. What size paper are you expecting with this code?

It looks as if you expect the user to position charts vertically on the worksheet so they fall between horizontal page breaks to determine which page they print on. If they straddle a horizontal page break then the chart is ignored. Is this a desired occurrence, or should a warning be given.

What if there are 5 charts on a page? Should the user be alerted if there are 5 or more than 6 charts using the current chart distribution?

A horizontal page break is not automatically generated after the last chart, so a dummy chart should be added below where the next horizontal break would occur then be ignored during processing. Any pages without graphs would also be ignored.
 
Upvote 0
Code: 
Sub ChartResize()
    Application.ScreenUpdating = False
    Application.ScreenUpdating = False
    On Error Resume Next
    Dim I
    For I = 1 To 150

        ActiveSheet.ChartObjects("Chart " & I).Activate
        ActiveSheet.Shapes("Chart " & I).Height = 6.8 * 72    '324.8503937008
        ActiveSheet.Shapes("Chart " & I).Width = 9.3 * 72  '399.4015748031
        ActiveSheet.Shapes("TextBox " & I).Width = 9.3 * 72
        ActiveSheet.Shapes("TextBox " & I).Height = 1 * 72
        ActiveSheet.Shapes("Chart " & I).Line.Visible = msoFalse

        With ActiveChart.Axes(xlValue).AxisTitle
            .Select
            .Font.Size = 12
        End With
        With ActiveChart.ChartTitle
            .Select
            .Font.Size = 20
        End With
    Next I
    Application.ScreenUpdating = True
End Sub

and for landscape set three cols and fixed row heights
Code: 
 Columns("A:C").ColumnWidth = 130.29

    Rows("3:3").RowHeight = 409
    Rows("4:4").RowHeight = 90.75
    Rows("5:5").RowHeight = 153
    Rows("6:6").RowHeight = 409
    Rows("7:7").RowHeight = 90.75
    Rows("8:8").RowHeight = 153

    Rows("9:9").RowHeight = 409
    Rows("10:10").RowHeight = 90.75
    Rows("11:11").RowHeight = 153
    Rows("12:12").RowHeight = 409
    Rows("13:13").RowHeight = 90.75
    Rows("14:14").RowHeight = 153

    Rows("15:15").RowHeight = 409
    Rows("16:16").RowHeight = 90.75
    Rows("17:17").RowHeight = 153
    Rows("18:18").RowHeight = 409
    Rows("19:19").RowHeight = 90.75
    Rows("20:20").RowHeight = 153
 
Upvote 0
pbornemeier said:
You are using landscape page orientation. What size paper are you expecting with this code?

It looks as if you expect the user to position charts vertically on the worksheet so they fall between horizontal page breaks to determine which page they print on. If they straddle a horizontal page break then the chart is ignored. Is this a desired occurrence, or should a warning be given.

What if there are 5 charts on a page? Should the user be alerted if there are 5 or more than 6 charts using the current chart distribution?

A horizontal page break is not automatically generated after the last chart, so a dummy chart should be added below where the next horizontal break would occur then be ignored during processing. Any pages without graphs would also be ignored.
Click to expand...

First, Merry Post-Christmas to all of us who had to work today :)
I added a modified version that handles 1-6 charts per page. Page orientation is landscape with column A not being used for the charts; only columns B-T, page break after every 42 row.
To try out my working project see, http://rodericke.com/chartresize All code open for your review. See macro: Count_Charts_On_Each_Page()
 
Upvote 0
mole999 said:
Code: 
Sub ChartResize()
    Application.ScreenUpdating = False
    Application.ScreenUpdating = False
    On Error Resume Next
    Dim I
    For I = 1 To 150

        ActiveSheet.ChartObjects("Chart " & I).Activate
        ActiveSheet.Shapes("Chart " & I).Height = 6.8 * 72    '324.8503937008
        ActiveSheet.Shapes("Chart " & I).Width = 9.3 * 72  '399.4015748031
        ActiveSheet.Shapes("TextBox " & I).Width = 9.3 * 72
        ActiveSheet.Shapes("TextBox " & I).Height = 1 * 72
        ActiveSheet.Shapes("Chart " & I).Line.Visible = msoFalse

        With ActiveChart.Axes(xlValue).AxisTitle
            .Select
            .Font.Size = 12
        End With
        With ActiveChart.ChartTitle
            .Select
            .Font.Size = 20
        End With
    Next I
    Application.ScreenUpdating = True
End Sub

and for landscape set three cols and fixed row heights
Code: 
 Columns("A:C").ColumnWidth = 130.29

    Rows("3:3").RowHeight = 409
    Rows("4:4").RowHeight = 90.75
    Rows("5:5").RowHeight = 153
    Rows("6:6").RowHeight = 409
    Rows("7:7").RowHeight = 90.75
    Rows("8:8").RowHeight = 153

    Rows("9:9").RowHeight = 409
    Rows("10:10").RowHeight = 90.75
    Rows("11:11").RowHeight = 153
    Rows("12:12").RowHeight = 409
    Rows("13:13").RowHeight = 90.75
    Rows("14:14").RowHeight = 153

    Rows("15:15").RowHeight = 409
    Rows("16:16").RowHeight = 90.75
    Rows("17:17").RowHeight = 153
    Rows("18:18").RowHeight = 409
    Rows("19:19").RowHeight = 90.75
    Rows("20:20").RowHeight = 153
Click to expand...

Ok going to test this now. I'll have to modify a bit as my charts are in columns B-T and pagebreaks after every 42nd row
 
Upvote 0
Mole999,
Is your code suppose to consider how many charts are within the pagebreak area? It seemed to just run them all together when I ran it. Do you have a working sample? Thanks
 
Upvote 0
Phil, I didn't answer all your questions on my initial reply. Here's the code that handles 1-6 charts per page.
The expectation is that the user will manually place 1-6 charts within each page break area. If a chart straddles a horizontal pagebreak line it will not be resized/postioned. If there are more than 6 charts noting on that pagebreak page will be changed. You are correct about needed a dummy chart on the last pagebreak.
I did not plan on giving the user warnings if they exceed 6 charts or position overlapping since I will tell them that in the initial instructions.
While the user could printout the worksheet, it will be landscape 8.5x11 but typically they will just view on-screen or export as PDF.

Code: 
Public Sub Count_Charts_On_Each_Page()


    Dim page As Long
    Dim chartObj As ChartObject
    Dim HPageBreakStartRow As Long
    Dim numChartsOnPage As Long
Dim pagecharts As Variant
ReDim pagecharts(0 To 0)
baseleft = 232
basetop = 4
basemid = 280
basewidth = 450
baseheight = 274
    
    HPageBreakStartRow = 1
    With ActiveWorkbook.ActiveSheet
        For page = 1 To .HPageBreaks.Count
            numChartsOnPage = 0
            'Debug.Print page, HpageBreakStartRow, .HPageBreaks(page).Location.Row
            For Each chartObj In .ChartObjects
                'Debug.Print chartObj.BottomRightCell.Address
                If chartObj.TopLeftCell.Row >= HPageBreakStartRow And chartObj.BottomRightCell.Row < .HPageBreaks(page).Location.Row Then
                    numChartsOnPage = numChartsOnPage + 1
                    'MsgBox chartObj.Name & " is on page " & page
    pagecharts(UBound(pagecharts)) = chartObj.Name & "=" & Right("0" & page, 2)
    ReDim Preserve pagecharts(UBound(pagecharts) + 1) 'Allocate next element
                    
                End If
            Next
            'MsgBox numChartsOnPage & " charts on page " & page
            HPageBreakStartRow = .HPageBreaks(page).Location.Row
        Next
    End With
On Error Resume Next 'instead of checking if array was used
ReDim Preserve pagecharts(LBound(pagecharts) To UBound(pagecharts) - 1)  'Deallocate the last, unused element
Resume Next
For Each element In pagecharts
If InStr(element, "=01") Then
cnt1 = cnt1 + 1
End If
If InStr(element, "=02") Then
cnt2 = cnt2 + 1
End If
If InStr(element, "=03") Then
cnt3 = cnt3 + 1
End If
If InStr(element, "=04") Then
cnt4 = cnt4 + 1
End If
Next




For Each element In pagecharts


'PAGE 1
'1 chart
If Right(element, 3) = "=01" Then
If cnt1 = 1 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight * 2
End If
'2 charts
If cnt1 = 2 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth * 2
If hit1 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
End If
If hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
End If
End If
'3 charts
If cnt1 = 3 And Right(element, 3) = "=01" Then
If hit1 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
End If
If hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
End If
If hit1 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
End If
End If
'4 charts
If cnt1 = 4 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
If hit1 = 0 Or hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
End If
If hit1 = 0 Or hit1 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
End If
If hit1 = 1 Or hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + basewidth + 3
End If
If hit1 = 2 Or hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
End If
End If
'5 charts
If cnt1 = 5 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
If hit1 = 0 Or hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
End If
If hit1 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + basewidth + 3
End If
If hit1 = 0 Or hit1 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
End If
If hit1 > 1 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = (basewidth / 3) + 150
End If
If hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit1 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit1 >= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
End If
End If
'6 charts
If cnt1 = 6 And Right(element, 3) = "=01" Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Height = baseheight
If hit1 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basetop
End If
If hit1 = 0 Or hit1 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft
End If
If hit1 = 1 Or hit1 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit1 = 2 Or hit1 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit1 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=01", "")).Top = basemid
End If
End If
hit1 = hit1 + 1
End If


'PAGE 2
'1 chart
If Right(element, 3) = "=02" Then
'extended
basetop = 608
basemid = 885
If cnt2 = 1 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight * 2
End If
'2 charts
If cnt2 = 2 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth * 2
If hit2 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
End If
If hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
End If
End If
'3 charts
If cnt2 = 3 And Right(element, 3) = "=02" Then
If hit2 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
End If
If hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
End If
If hit2 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
End If
End If
'4 charts
If cnt2 = 4 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
If hit2 = 0 Or hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
End If
If hit2 = 0 Or hit2 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
End If
If hit2 = 1 Or hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + basewidth + 3
End If
If hit2 = 2 Or hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
End If
End If
'5 charts
If cnt2 = 5 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
If hit2 = 0 Or hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
End If
If hit2 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + basewidth + 3
End If
If hit2 = 0 Or hit2 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
End If
If hit2 > 1 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = (basewidth / 3) + 150
End If
If hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit2 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit2 >= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
End If
End If
'6 charts
If cnt2 = 6 And Right(element, 3) = "=02" Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Height = baseheight
If hit2 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basetop
End If
If hit2 = 0 Or hit2 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft
End If
If hit2 = 1 Or hit2 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit2 = 2 Or hit2 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit2 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=02", "")).Top = basemid
End If
End If
hit2 = hit2 + 1
End If


'PAGE 3
'1 chart
If Right(element, 3) = "=03" Then
'extended
basetop = 1216
basemid = 1494
If cnt3 = 1 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight * 2
End If
'2 charts
If cnt3 = 2 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth * 2
If hit3 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
End If
If hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
End If
End If
'3 charts
If cnt3 = 3 And Right(element, 3) = "=03" Then
If hit3 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
End If
If hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
End If
If hit3 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
End If
End If
'4 charts
If cnt3 = 4 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
If hit3 = 0 Or hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
End If
If hit3 = 0 Or hit3 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
End If
If hit3 = 1 Or hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + basewidth + 3
End If
If hit3 = 2 Or hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
End If
End If
'5 charts
If cnt3 = 5 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
If hit3 = 0 Or hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
End If
If hit3 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + basewidth + 3
End If
If hit3 = 0 Or hit3 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
End If
If hit3 > 1 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = (basewidth / 3) + 150
End If
If hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit3 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit3 >= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
End If
End If
'6 charts
If cnt3 = 6 And Right(element, 3) = "=03" Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Height = baseheight
If hit3 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basetop
End If
If hit3 = 0 Or hit3 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft
End If
If hit3 = 1 Or hit3 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit3 = 2 Or hit3 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit3 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=03", "")).Top = basemid
End If
End If
hit3 = hit3 + 1
End If


'PAGE 4
'1 chart
If Right(element, 3) = "=04" Then
'extended
basetop = 1821
basemid = 2098
If cnt4 = 1 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight * 2
End If
'2 charts
If cnt4 = 2 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth * 2
If hit4 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
End If
If hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
End If
End If
'3 charts
If cnt4 = 3 And Right(element, 3) = "=04" Then
If hit4 = 0 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth * 2
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
End If
If hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
End If
If hit4 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
End If
End If
'4 charts
If cnt4 = 4 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
If hit4 = 0 Or hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
End If
If hit4 = 0 Or hit4 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
End If
If hit4 = 1 Or hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + basewidth + 3
End If
If hit4 = 2 Or hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
End If
End If
'5 charts
If cnt4 = 5 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
If hit4 = 0 Or hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
End If
If hit4 = 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + basewidth + 3
End If
If hit4 = 0 Or hit4 = 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
End If
If hit4 > 1 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = (basewidth / 3) + 150
End If
If hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit4 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit4 >= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
End If
End If
'6 charts
If cnt4 = 6 And Right(element, 3) = "=04" Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Height = baseheight
If hit4 <= 2 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basetop
End If
If hit4 = 0 Or hit4 = 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft
End If
If hit4 = 1 Or hit4 = 4 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit4 = 2 Or hit4 = 5 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit4 >= 3 Then
ActiveSheet.ChartObjects(Replace(element, "=04", "")).Top = basemid
End If
End If
hit4 = hit4 + 1
End If












Next
MsgBox "Resizing and Repositioning done", vbInformation, "Complete"


End Sub
 
Upvote 0
This is my code that finally worked as intended. Not reflected yet on the rodericke.com link I gave:

Code: 
Sub snapcharts()
    Dim page As Long
    Dim chartObj As ChartObject
    Dim HPageBreakStartRow As Long
    Dim numChartsOnPage As Long
Dim pagecharts As Variant
Dim chartstr As String
ReDim pagecharts(0 To 0)
baseleft = 232
basetop = 4
basemid = 280
basewidth = 450
baseheight = 274
    
    HPageBreakStartRow = 1
    With ActiveWorkbook.ActiveSheet
        For page = 1 To .HPageBreaks.Count
            numChartsOnPage = 0
            'Debug.Print page, HpageBreakStartRow, .HPageBreaks(page).Location.Row
            For Each chartObj In .ChartObjects
                'Debug.Print chartObj.BottomRightCell.Address
                If chartObj.TopLeftCell.Row >= HPageBreakStartRow And chartObj.BottomRightCell.Row < .HPageBreaks(page).Location.Row Then
                    numChartsOnPage = numChartsOnPage + 1
                    'MsgBox chartObj.Name & " is on page " & page
    pagecharts(UBound(pagecharts)) = chartObj.Name & "=" & Right("0" & page, 2)
    If chartstr = "" Then
    chartstr = chartstr & chartObj.Name & "=" & Right("0" & page, 2)
    Else
    chartstr = chartstr & "," & chartObj.Name & "=" & Right("0" & page, 2)
    End If
    
    
    ReDim Preserve pagecharts(UBound(pagecharts) + 1) 'Allocate next element
                    
                End If
            Next
            'MsgBox numChartsOnPage & " charts on page " & page
            HPageBreakStartRow = .HPageBreaks(page).Location.Row
        Next
    End With
On Error Resume Next 'instead of checking if array was used
ReDim Preserve pagecharts(LBound(pagecharts) To UBound(pagecharts) - 1)  'Deallocate the last, unused element
Resume Next


'need way to consider last pagebreak or put in blank dummy pagebreak at end






basetop1 = 608 'default top multiplier
ecnt = 0 'loop count through pagebreaks
For Each element In pagecharts
cnt = (Len(chartstr) - Len(Application.Substitute(chartstr, Right(element, 3), ""))) / 3 'count charts on each pagebreak






'set top and mid for different pages
If Right(element, 3) = "=02" Then
basetop = 608
basetmid = 885
End If
If Right(element, 3) <> "=01" Then
basemid = basetop + 277
End If




'PAGE 1
'1 chart
If cnt = 1 Then
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), "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Height = baseheight * 2
End If
'2 charts
If cnt = 2 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Width = basewidth * 2
If hit = 0 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Height = baseheight
End If
If hit = 1 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Height = baseheight
End If
End If
'3 charts
If cnt = 3 Then
If hit = 0 Then
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), "")).Top = basetop
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Height = baseheight
End If
If hit = 1 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Width = basewidth
End If
If hit = 2 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft + basewidth + 3
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Top = basemid
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Height = baseheight
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Width = basewidth
End If
End If
'4 charts
If cnt = 4 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Height = baseheight
If hit = 0 Or hit = 1 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Top = basetop
End If
If hit = 0 Or hit = 2 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft
End If
If hit = 1 Or hit = 3 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft + basewidth + 3
End If
If hit = 2 Or hit = 3 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Top = basemid
End If
End If
'5 charts
If cnt = 5 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Width = basewidth
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Height = baseheight
If hit = 0 Or hit = 1 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Top = basetop
End If
If hit = 1 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft + basewidth + 3
End If
If hit = 0 Or hit = 2 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft
End If
If hit > 1 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Width = (basewidth / 3) + 150
End If
If hit = 3 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit = 4 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit >= 2 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Top = basemid
End If
End If
'6 charts
If cnt = 6 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Width = (basewidth / 3) + 150
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Height = baseheight
If hit <= 2 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Top = basetop
End If
If hit = 0 Or hit = 3 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft
End If
If hit = 1 Or hit = 4 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft + (basewidth / 3) + 153
End If
If hit = 2 Or hit = 5 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Left = baseleft + (basewidth / 3) + 455
End If
If hit >= 3 Then
ActiveSheet.ChartObjects(Replace(element, Right(element, 3), "")).Top = basemid
End If
End If
hit = hit + 1
ecnt = ecnt + 1


'reset chart hit if new pagebreak
If Right(element, 3) <> Right(pagecharts(ecnt), 3) Then
hit = 0
basetop = (basetop + basetop1) - (Evaluate(Right(element, 3)) + 3 - Evaluate(Right(element, 3))) 'set basetop for next pagebreak
End If


Next
MsgBox "Resizing and Repositioning done", vbInformation, "Complete"
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
348
Agnarr
Agnarr
D
  • Solved
Organize Layout of All Charts
Replies
3
Views
329
Domenic
D
S
  • Question
Excel VBA Getting error when creating pivot chart but error only occurs after sub that creates pivot tables. No error if directly called
Replies
0
Views
642
Steve48
S
D
  • Question
Problems Encountered When Generating VBA Excel Charts with 15-Minute Interval Data.
Replies
0
Views
158
dilshod_k
D
A
  • Question
Userform exit while code is running
Replies
1
Views
597
Domenic
D

Forum statistics

Threads
1,215,013
Messages
6,122,690
Members
449,092
Latest member
snoom82

Share this page

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