Copy and Paste Charts as Picture in Different Workbook
Sub test()
Dim nPicCnt As Long
Dim chtObj As ChartObject
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim pic As Picture
Set wsSource = Workbooks("Book2").Worksheets("Sheet1")
Set wsDest = Workbooks("Book3").Worksheets("Sheet1")
nPicCnt = wsDest.Pictures.Count
For i = 1 To wsSource.ChartObjects.Count
Set chtObj = wsSource.ChartObjects(i)
chtObj.CopyPicture Appearance:=xlScreen, Format:=xlPicture
wsDest.Paste
nPicCnt = nPicCnt + 1
With wsDest.Pictures(nPicCnt)
.Left = chtObj.Left
.Top = chtObj.Top
End With
Next
End Sub
FWIW, if intention is to backup charts could copy/paste the actual charts
then break links to the original workbook. This would lead to smaller file
size, and retain the original data in the new workbook and without need to
replace data in cells in the new workbook. If interested I have an app in
development that does that.
Regards,
Peter T
pmbthornton gmail com
"SteveC" wrote in message
...
Better yet, how to select every single chart (not objects, no buttons) in
a
worksheet, and paste in a different sheet of a different workbook -- in
the
same place where the charts were located on the original sheet... many
thanks
"SteveC" wrote:
Here is my code... everything working except copying and pasting the
charts
as picture... no error, the picture of the excel chart just doesn't show
up.
thanks for any help. SteveC
Sub test copy excel charts
'code here, then:
Workbooks("Hot List.xls").Sheets("Snapshot").Cells.Copy
With ThisWorkbook.Sheets(ShName).Range("A1")
.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Workbooks("Hot List.xls").Sheets("Snapshot").Cells.Copy
.PasteSpecial _
Paste:=xlPasteFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Workbooks("Hot List.xls").Sheets("Snapshot").Cells.Copy
.PasteSpecial _
Paste:=xlPasteColumnWidths, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Workbooks("Hot
List.xls").Sheets("SnapShot").Shapes.Range(Array(" CIQChart1s0t0",
"CIQChart1s1t0")).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With ThisWorkbook.Sheets(ShName).Range("c48")
.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False _
, DisplayAsIcon:=False
End With
Application.CutCopyMode = False
'more code
End Sub
|