EileenJohn
Board Regular
- Joined
- Nov 23, 2016
- Messages
- 53
Hi, anyone know how to copy charts appearance and save it as chart title? For example in workbook A , I have sheets1, chart title Factory5. And I want to save it as Factory5.png.
Code:
Sub CopyChart()
Dim pic_rng As Range
Dim ShTemp As Worksheet
Dim ChTemp As Chart
Dim PicTemp As Picture
Application.ScreenUpdating = False
Set pic_rng = Worksheets("Factory5").Range("A1:Q21")
Set ShTemp = Worksheets.Add
DoEvents
Charts.Add
Application.DisplayAlerts = False
ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name
Set ChTemp = ActiveChart
pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
DoEvents
ChTemp.Paste
Set PicTemp = Selection
With ChTemp.Parent
.Width = PicTemp.Width + 540
.Height = PicTemp.Height + 310
End With
ChTemp.Export Filename:="D:\Charts\Factory5.png", FilterName:="png"
ShTemp.Delete
Application.ScreenUpdating = True
End Sub
The code above only set for 1 sheets. What if I want to apply it to workbook? For example: In WorkbookA, sheets1 and sheets4.
Code:
Sub CopyChart()
Dim pic_rng As Range
Dim ShTemp As Worksheet
Dim ChTemp As Chart
Dim PicTemp As Picture
Application.ScreenUpdating = False
Set pic_rng = Worksheets("Factory5").Range("A1:Q21")
Set ShTemp = Worksheets.Add
DoEvents
Charts.Add
Application.DisplayAlerts = False
ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name
Set ChTemp = ActiveChart
pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
DoEvents
ChTemp.Paste
Set PicTemp = Selection
With ChTemp.Parent
.Width = PicTemp.Width + 540
.Height = PicTemp.Height + 310
End With
ChTemp.Export Filename:="D:\Charts\Factory5.png", FilterName:="png"
ShTemp.Delete
Application.ScreenUpdating = True
End Sub
The code above only set for 1 sheets. What if I want to apply it to workbook? For example: In WorkbookA, sheets1 and sheets4.