Chart on a worksheet, find chart location

[headly]

What kind of VBA command(s) are there to determine if a chart (located on a
worksheet) is inside the print range/area? TIA for suggestions/advice

 

[Dave Peterson]

The print range (if it's been set) has a topleftcell and a bottomrightcell.

The chart also has a topleftcell and a bottomrightcell.

The chart could be entirely outside the print range, overlap slightly or be
entirely within the print range.

I'm not sure what distinction you're looking for, but this may give you a few
ideas:

Option Explicit
Sub testme()
Dim wks As Worksheet
Dim ChtObject As ChartObject
Dim myPrintRng As Range
Dim myChartRng As Range

'I used sheet1
Set wks = Worksheets("Sheet1")

With wks
Set myPrintRng = Nothing
On Error Resume Next
Set myPrintRng = .Range(.PageSetup.PrintArea)
On Error GoTo 0

If myPrintRng Is Nothing Then
MsgBox "The print range hasn't been set!"
Exit Sub
End If

'What's the name of the chart?
Set ChtObject = .ChartObjects("Chart 1")

With ChtObject
Set myChartRng = .Parent.Range(.TopLeftCell, .BottomRightCell)
End With

If Intersect(myPrintRng, myChartRng) Is Nothing Then
MsgBox "Separate with no overlap"
ElseIf Union(myPrintRng, myChartRng).Address = myPrintRng.Address Then
MsgBox "Contained in the print range"
Else
MsgBox "a little overlap"
End If
End With

End Sub

 

[Dave Peterson]

Ps. I did assume that the print range was a single area, too! That's not
always true.

 

[Peter T]

This should enable you to check if almost any object, including a single
area of cells, is within the printarea

Sub test()

res = IsInPrintArea(Selection)
MsgBox "IsInPrintArea = " & res

End Sub
Function IsInPrintArea(ByVal obj As Object) As Boolean
Dim bFlag As Boolean
Dim sAddr As String
Dim rngPrint As Range
Dim oWS As Object

'On Error GoTo errExit
If TypeName(obj.Parent) <> "Worksheet" Then
Set obj = obj.Parent ' Chart to ChartObject
If TypeName(obj.Parent) <> "Worksheet" Then
Set obj = obj.Parent ' Chart to ChartObject
End If
End If

Set ws = obj.Parent

sAddr = ws.PageSetup.PrintArea
If Len(sAddr) = 0 Then
' no custom printarea, so everything will be printed
IsInPrintArea = True
Else
Set rngPrint = ws.Range(sAddr)
For Each ar In rngPrint.Areas
With obj
If TypeName(obj) = "Range" Then
bFlag = _
Not Intersect(rngPrint, .Item(1)) Is Nothing _
And Not Intersect(rngPrint, .Item(.Count)) Is Nothing
Else
bFlag = _
Not Intersect(rngPrint, .TopLeftCell) Is Nothing _
And Not Intersect(rngPrint, .BottomRightCell) Is Nothing
End If
If bFlag Then Exit For
End With
Next
IsInPrintArea = bFlag
End If

errExit:
End Function

Regards,
Peter T

 

[Peter T]

That wasn't quite right for a number of reasons, hopefully this is better

Sub test()
Dim res As Boolean
res = IsInPrintArea(Selection)
MsgBox "IsInPrintArea = " & res

End Sub

Function IsInPrintArea(ByVal obj As Object) As Boolean
Dim bFlag As Boolean
Dim sAddr As String
Dim rngPrint As Range, ar As Range
Dim ws As Worksheet

'On Error GoTo errExit
If TypeName(obj.Parent) <> "Worksheet" Then
Set obj = obj.Parent ' Chart to ChartObject
If TypeName(obj.Parent) <> "Worksheet" Then
Set obj = obj.Parent ' Chart to ChartObject
End If
End If

Set ws = obj.Parent

sAddr = ws.PageSetup.PrintArea
If Len(sAddr) = 0 Then
' no custom printarea, so everything will be printed
IsInPrintArea = True
Else
Set rngPrint = ws.Range(sAddr)
For Each ar In rngPrint.Areas
With obj
If TypeName(obj) = "Range" Then
bFlag = _
Not Intersect(ar, .Item(1)) Is Nothing _
And Not Intersect(ar, .Item(.Count)) Is Nothing
Else
bFlag = _
Not Intersect(ar, .TopLeftCell) Is Nothing _
And Not Intersect(ar, .BottomRightCell) Is Nothing
End If
If bFlag Then Exit For
End With
Next
IsInPrintArea = bFlag
End If

errExit:
End Function

Regards,
Peter T