View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Ivyleaf Ivyleaf is offline
external usenet poster
 
Posts: 141
Default Copy charts and remove links to original source data

On Apr 15, 11:53*pm, Sarah (OGI)
wrote:
Ivan

Thank you, so so much!! - that works a treat! *

One thing though, each sheet displays summary information relating to the
charts. *This data contains formulas which reference other worksheets that
are no longer shown in the new workbook. *Therefore, I need to do a
copy/pastespecial to remove the formulas. *Where/how can I include this in
the code? - I tried to insert ".PasteSpecial Paste:=Values,
Operation:=xlNone, SkipBlanks:=False, Transpose:=False" within the 2nd For
Each in the With section, where the code already states .Paste, but this
causes it to fall over.

Thanks again.



"Ivyleaf" wrote:
On Apr 7, 9:07 pm, Sarah (OGI)
wrote:
Ivan
Many thanks for your assistance.


I've used the following code, but the organisation of the data has since
changed - does this mean that the code might have to be amended slightly? -
apologies if that is the case, as I do really appreciate your help with this.


There are still pivot tables and still the same number of charts, but the
charts are no longer pivot table charts - they are stand alone (embedded)
charts that are based on different data tables. *The sheets containing the
charts now also have a summary of information relating to it, so I need to
copy the values and formatting for all the data and the charts on each sheet
into a new workbook. *Will it make the copying out process easier if not
pivot-table charts?


Using the code you provided, I've tried to accomodate the copying of each
sheet as an array (not sure if this is correct)? *Also, based on the code
below, it seems to fall over at the point of 'Chart.CopyPicture
Appearance:=xlScreen, Format:=xlPicture', saying that 'object doesn't support
this property or method'.


Sub CopyChart()
* * *Dim ChartBook As Workbook, SourceBook As Workbook
* * *Dim TmpSheets As Integer


* * *Set SourceBook = ActiveWorkbook
* * *TmpSheets = Application.SheetsInNewWorkbook
* * *Application.SheetsInNewWorkbook = ActiveWorkbook.Charts.Count + 6
* * *Set ChartBook = Workbooks.Add
* * *Application.SheetsInNewWorkbook = TmpSheets
* * *TmpSheets = 1


* * *'For Each Chart In SourceBook.Charts
* * *' * *Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
* * *' * *With ChartBook.Sheets(TmpSheets)
* * *' * * * *.Activate.PasteSpecial Format:="Picture (Enhanced Metafile)",
Link:=False, DisplayAsIcon:=False
* * *' * * * *.Name = Chart.Name
* * *' * *End With
* * *' * *ActiveWindow.DisplayGridlines = False
* * *' * *TmpSheets = TmpSheets + 1
* * *'Next


* * *For Each Chart In SourceBook.Sheets(Array("PC (Chart)-UK-MONTH", "PC
(Chart)-NI-MONTH"))
* * * * *Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
* * * * *With ChartBook.Sheets(TmpSheets)
* * * * * * *.Activate.PasteSpecial Format:="Picture (Enhanced Metafile)",
Link:=False, DisplayAsIcon:=False
* * * * * * *.Name = Chart.Name
* * * * *End With
* * * * *ActiveWindow.DisplayGridlines = False
* * * * *TmpSheets = TmpSheets + 1
* * *Next


*End Sub


"Ivyleaf" wrote:
On Apr 3, 11:28 pm, Ivyleaf wrote:
On Apr 3, 10:54 pm, Ivyleaf wrote:


On Apr 3, 10:29 pm, Sarah (OGI)
wrote:


I've got a workbook with multiple worksheets. *For every one worksheet with a
pivot table, there is a corresponding worksheet containing a chart relating
to that data source.


Via a macro, I'd like to be able to select all sheets containing '(Chart)'
in the worksheet name and copy them out into another workbook. *Would I do
this by selecting each sheet and doing a 'move/copy' to a new workbook? *
Once the sheets are exported, is there an easy way to remove all links to the
source data?


The idea is to use the initial workbook to update the source data and charts
on a monthly basis, then distribute the charts as a separate document. *The
recipients of such information (both internal and external contacts) should
not be able to access the original source data.


Many thanks in advance - my vb skills/knowledge is limited.


Cheers


Hi Sarah,


I'm sure I'll soon be corrected, but to my understanding you can't
have a chart without the underlying data being stored in a sheet
somewhere (pivot table / range etc). The only thing I can think of if
you absolutely must separate it from the data would be to copy the
chart object as a picture object and paste it into another sheet.. I
don't think you could pase to a 'chart' sheet though, it would have to
just be a normal worksheet that you are pasting the object onto.


The code would go something like this for the actual copy process:


Sub CopyChart()
* * ActiveChart.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
* * Sheets("Sheet2").Select
* * ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", _
* * * * Link:=False, DisplayAsIcon:=False
End Sub


Cheers,
Ivan.- Hide quoted text -


- Show quoted text -


Hi Sarah,


Just some more code... This will loop through the current workbook,
make a new one and copy all the charts to the new one as pictures. It
will also rename all the sheets in the new book to match the names in
the source book. The only thing that might be a bit tricky is getting
the sizing right. You can get the active window size, but I'm not sure
off the top of my head how to work out how much to subtract for scroll
bars etc. Anyway, hope this helps:


Sub CopyChart()
* * Dim ChartBook As Workbook, SourceBook As Workbook
* * Dim TmpSheets As Integer


* * Set SourceBook = ActiveWorkbook
* * TmpSheets = Application.SheetsInNewWorkbook
* * Application.SheetsInNewWorkbook = ActiveWorkbook.Charts.Count
* * Set ChartBook = Workbooks.Add
* * Application.SheetsInNewWorkbook = TmpSheets
* * TmpSheets = 1


* * For Each Chart In SourceBook.Charts
* * * * Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
* * * * With ChartBook.Sheets(TmpSheets)
* * * * * * .PasteSpecial Format:="Picture (Enhanced Metafile)", _
* * * * * * * * Link:=False, DisplayAsIcon:=False
* * * * * * .Name = Chart.Name
* * * * End With
* * * * ActiveWindow.DisplayGridlines = False
* * * * TmpSheets = TmpSheets + 1
* * Next
End Sub


Cheers,
Ivan.- Hide quoted text -


- Show quoted text -


Hi Sarah,


I just noticed a problem with my code. It looks like the .PasteSpecial
method in this context pastes to the Active sheet regardless of the
fact I am calling it inside a With block. To solve this, just put the
line ".Activate" directly before it. That way it is activating the
correct sheet to paste to.


Cheers,
Ivan.- Hide quoted text -


- Show quoted text -


Hi Sarah,


This makes quite a bit of difference. I have re-worked it, and I
*think* this might do the trick for you, or close anyway:


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
* * * * .Paste
* * * * .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
* Next
End Sub


Let me know how you go.


Cheers,
Ivan.- Hide quoted text -


- Show quoted text -


Hi Sarah,

Try just putting the line:

.Cells.PasteSpecial Paste:=xlPasteValues

after the ".Paste" line. This should fix your problem. The only
difference is that you were trying to 'PasteSpecial' to a sheet, where
I believe you can only use that method on a range... hence the
'.Cells' in frot of it.

Hope this helps.

Cheers,
Ivan.