View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default 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