Prevent a chart spanning two pages?

[MrPez]

Is there an easy way to prevent a chart being split over two pages when printed? I have a chart at the end of a large amount of data which will resize depending on the data available.
When the report is printed I don't want the chart to be split, I'd rather it was just on the next page in one piece.

Is this easy to do?

Thanks

 

[Worf]

Tag: Excel worksheet page address.

• Not that easy, but the code below does it.
• If the last worksheet page is empty, then the chart is placed there.
• If not, new pages are created and the chart goes into one of them. Are blank pages a problem for you?

Dim s$
Sub PositionChart()
Dim vr, lastp$, rn%, i%, co As ChartObject
Set co = ActiveSheet.ChartObjects("chart3")         ' the chart
PageAddress2 0                                      ' get page addresses
vr = Split(s, vbLf)
lastp = vr(UBound(vr) - 1)                          ' last page
co.ShapeRange.LockAspectRatio = msoTrue
If WorksheetFunction.CountA(Range(lastp)) = 0 Then  ' last page is empty
    co.Top = Range(lastp).Cells(1, 1).Top + 2
    co.Left = Range(lastp).Cells(1, 1).Left + 2
    co.Width = Range(vr(LBound(vr))).Width - 10
Else
    rn = Split(ActiveSheet.UsedRange.Address, "$")(4) + Range(vr(LBound(vr))).Rows.count
    Cells(rn, 1) = "create new page"
    PageAddress2 0                                  ' update page addresses
    vr = Split(s, vbLf)
    For i = LBound(vr) To UBound(vr)                ' get new page number
        If Not Intersect(Cells(rn, 1), Range(vr(i))) Is Nothing Then Exit For
    Next
    co.Top = Range(vr(i)).Cells(1, 1).Top + 2       ' position chart
    co.Left = Range(vr(i)).Cells(1, 1).Left + 2
    co.Width = Range(vr(i)).Width - 10
End If
End Sub


Sub PageAddress2(colorcode As Boolean)
Dim c%, v%, h%, cln%, rw%, hgth%, wth%, ws As Worksheet, i%, r As Range, pag()
Set ws = ActiveSheet
c = 1: s = ""
ActiveWindow.View = xlPageBreakPreview
ReDim Preserve pag(1 To (ws.VPageBreaks.count + 1) * (ws.HPageBreaks.count + 1))     'all pages on that sheet
For v = 0 To ws.VPageBreaks.count
    For h = 0 To ws.HPageBreaks.count
        If v = ws.VPageBreaks.count Then
            wth = ws.UsedRange.Columns(ws.UsedRange.Columns.count).Column
        Else
            wth = ws.VPageBreaks(v + 1).Location.Column - 1
        End If
        If h = ws.HPageBreaks.count Then
            hgth = ws.UsedRange.Rows(ws.UsedRange.Rows.count).Row
        Else
            hgth = ws.HPageBreaks(h + 1).Location.Row - 1
        End If
        If v = 0 Then
            cln = 1
        Else
            cln = ws.VPageBreaks(v).Location.Column
        End If
        If h = 0 Then
            rw = 1
        Else
            rw = ws.HPageBreaks(h).Location.Row
        End If
        Set pag(c) = ws.Range(ws.Cells(rw, cln).Address & ":" & ws.Cells(hgth, wth).Address)     ' page address
        s = s & pag(c).Address & vbLf
        If colorcode Then pag(c).Interior.Color = RGB(CInt(250 * Rnd), CInt(250 * Rnd), CInt(250 * Rnd))
        c = c + 1
    Next
Next
'MsgBox s                                                                               ' all addresses
End Sub

 

[MrPez]

Tag: Are blank pages a problem for you?

Not really, that should be fine. Thanks!