Export two overlapping charts to .gif
L,
I'm assuming you want to arrange on chart above the other and that
both are the same dimensions.
If that's not the case then I'm sure you will be able to adapt this.
Tested OK for me (Excel 2002 on XP)
Tim.
Option Explicit
Sub Tester()
ExportBoth "Chart 1", "Chart 2"
End Sub
Sub ExportBoth(Chart1 As String, Chart2 As String)
Dim c As ChartObject
Dim e1 As ChartObject
Dim e2 As ChartObject
With ActiveSheet
Set e1 = .ChartObjects(Chart1)
Set e2 = .ChartObjects(Chart2)
Set c = .ChartObjects.Add(10, 10, 10, 10)
End With
c.Height = e1.Height + e2.Height + 10
c.Width = e1.Width + 10
e1.Chart.CopyPicture _
Appearance:=xlPrinter, Size:=xlScreen, _
Format:=xlPicture
c.Chart.Paste
e2.Chart.CopyPicture _
Appearance:=xlPrinter, Size:=xlScreen, _
Format:=xlPicture
c.Chart.Paste
With c.Chart
.Shapes(1).Left = 1
.Shapes(1).Top = 1
.Shapes(2).Left = 1
.Shapes(1).Top = c.Chart.Shapes(1).Height
.Export ThisWorkbook.Path & "\two charts.gif", "GIF"
End With
c.Delete
End Sub
"DynamiteSkippy" wrote in
message ...
Perhaps I am misunderstanding you but I can't seem to get that to
work. I
played around with it and I am not sure that the entire 'container'
chart
actually works. Everytime it completely replaces the object.
Could you give me a little more explaination or code??
-L
"Tim Williams" wrote:
Bit complicated, but you could create an empty chart as a container
and then use CopyPicture to copy each chart and paste it into the
container chart. Then export the container chart.
Sub Macro1()
With ActiveSheet
.ChartObjects("Chart 2").Chart.CopyPicture _
Appearance:=xlPrinter, Size:=xlScreen,
Format:=xlPicture
.ChartObjects("container").Chart.Paste
.ChartObjects("Chart 1").Chart.CopyPicture _
Appearance:=xlPrinter, Size:=xlScreen,
Format:=xlPicture
.ChartObjects("container").Chart.Paste
'now position the pictures and size the container....
End With
'export the container chart
End Sub
Tim.
"DynamiteSkippy" wrote
in
message ...
I have a worksheet with two overlapping charts and I am trying to
export them
to .gif picture format. I have tried several ways and have run
out
of
creativity... Can anyone help??
Private Sub ChartExporter()
Dim SaveLoc As String
Dim Pict As Object
Dim chrt
Dim i As Integer
PowerWord1
Set Pict =
ThisWorkbook.Worksheets("Front").Shapes.Range(Arra y("Trend_Chart",
"Discrete_Chart")).Select
'ThisWorkbook.Worksheets("Front").ChartGroups()
''ERROR: out
of range???
'ActiveSheet.Shapes.Range(Array("Trend_Chart",
"Discrete_Chart")).Select ''ERROR: Object Required???
'ThisWorkbook.Worksheets("Front").Shapes.Range(Arr ay("Trend_Chart",
"Discrete_Chart")).Select ''ERROR: Object Required???
Set chrt = Pict.chart
SaveLoc = ThisWorkbook.Path & Application.PathSeparator &
"Chart"
& ".gif"
chrt.Export Filename:=SaveLoc, FilterName:="GIF"
'Clear chart variable
Set chrt = Nothing
PowerWord2
End Sub
|