Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 ================== |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Adapt code to show filter | Excel Programming | |||
Adapt code to loop through sheets | Excel Programming | |||
Using Find/Replace in Visual basic to adapt the code | Excel Programming | |||
code for pictures in comments | Excel Programming | |||
Please help me to adapt this code. | Excel Programming |