Adapt code to copy out pictures as well

[Sarah (OGI)]

I've got the following code which exports all sheets containing charts to a
new workbook. Each sheet name is also copied across, as well as all summary
information.

I've now added 8 logo's onto each source sheet, therefore in the process of
copying out the chart sheets, I'd like to be able to copy the new pictures
(inc. the size, position, etc) as well.

Any ideas as to how I might be able to do this?

=================

Sub CopyChart()
Dim ChartBook As Workbook, SourceBook As Workbook
Dim TmpSheets As Integer, wkSheet As Worksheet
Dim ChartObj, ChartCount As Long

Set SourceBook = ActiveWorkbook

For Each wkSheet In SourceBook.Sheets
If wkSheet.ChartObjects.Count > 0 Then
ChartCount = ChartCount + 1
End If
Next

If ChartCount < 1 Then Exit Sub

TmpSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = ChartCount
Set ChartBook = Workbooks.Add
Application.SheetsInNewWorkbook = TmpSheets
TmpSheets = 1

For Each wkSheet In SourceBook.Sheets
If wkSheet.ChartObjects.Count > 0 Then
With ChartBook.Sheets(TmpSheets)
.Activate
.Name = wkSheet.Name
wkSheet.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.Cells.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
'.Paste
'.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
.ChartObjects.Delete
End With
ChartCount = 1
For Each ChartObj In wkSheet.ChartObjects
ChartObj.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ChartBook.Sheets(TmpSheets) _
.PasteSpecial Format:="Picture (Enhanced Metafile)", _
Link:=False, DisplayAsIcon:=False
With ChartBook.Sheets(TmpSheets).Shapes(ChartCount)
.Top = ChartObj.Top
.Left = ChartObj.Left
End With
ChartCount = ChartCount + 1
Next
TmpSheets = TmpSheets + 1
End If
Range("A1").Select
Next

End Sub
==================

 

[James Snell]

Just a thought here - to reduce code and make it more manageable, would it be
better to Save As and then remove the content that you don't want to retain
from there?

 

[Dave Peterson]

I'd add a line to this code that would do the picture copying:

....
Call CopyAllPictures

End sub

You have a response to your picture post.