Help with VBA Code for Excel to Powerpoint Export

[penndro]

Hi I have been trying to piece together some code that would easily allow me to move named ranges (picture tool) images to specific slides in Powerpoint.

My excel tabs that has all the ranges is "Copy_Charts". My powerpoint presentation is QBR.ppt.

The current Code I am using does a go job of dumping all chart objects into a specified folder; howerver, I have pictures (named ranges) that I need copied to Powerpoint as images (non linked)as well.

=============
Public Sub ExportCharts(SheetName As String, TargetFolder As String, Format As String)
Dim mySheet As Worksheet
Dim myObject As ChartObject
Dim myChart As Chart

Set mySheet = Worksheets(SheetName)
For Each myObject In mySheet.ChartObjects
Set myChart = myObject.Chart
myChart.Export TargetFolder & "\" & myObject.Name & "." & Format, Format, False
Next
End Sub
===================

 

[SkipVought]

hi,

Check out the CopyPicture method in VBA Help.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[penndro]

Ok, thanks Skip. One question on that though... Do you know if VBA would read the Excel range as an image or data range?

 

[SkipVought]

The method "Copies the selected object to the Clipboard as a picture."

Could it be any clearer?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[penndro]

Skip,

It is clear. I now have the ranges copied and pasted as pictures in my worksheet. The Export function is not working in my code anymore.

How would I correct these statements to make that code export the images to the folder as it did the chart objects before?

Dim myObject As ChartObject
Dim myChart As Chart

 

[SkipVought]

Please post your code.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[penndro]

Thanks for your help Skip. What i did was incorporate the Copy method you suggested and it works fine to convert those ranges into a graphic object. Now I want to Export/Insert those specific images into an existing Powerpoint Presentation (QBR.ppt).

initially my code copied all chart objects into a folder that I linked the charts to Powerpoint. But this is not so practical as the links get broken everytime my colleagues share the powerpoint with others.

So I am trying to just have VBA copy those graphic object into the presentation directly as an image and not an embedded graphic object.


Here is my code:

=====================
Public Sub ExportCharts(SheetName As String, TargetFolder As String, Format As String)
Dim mySheet As Worksheet
Dim myObject As Object
Dim myChart As Object

Set mySheet = Worksheets(SheetName)
'Copy Pieces Chart
Worksheets("Customer Scorecard").Range("C921").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("B5")

'Copy Weight Chart
Worksheets("Customer Scorecard").Range("E9:H21").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("H5")

'Copy Revenue Chart
Worksheets("Customer Scorecard").Range("P18:U30").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("P5")

'Copy Pieces Table
Worksheets("Customer Scorecard").Range("C22:H37").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("B22")

'Copy Weight Table
Worksheets("Customer Scorecard").Range("C38:H53").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("B41")

'Copy Financial Summary Strip
Worksheets("Customer Scorecard").Range("J4:V16").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("B60")

'Copy DSO Table
Worksheets("Customer Scorecard").Range("L19:O29").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("R60")

'Copy Cases
Worksheets("Customer Scorecard").Range("F57:H60").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("R78")

'Copy Locations
Worksheets("Customer Scorecard").Range("K31:U48").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("B77")

'Copy Top 10 Lanes
Worksheets("Customer Scorecard").Range("K50:U62").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("B99")

'Copy Product Mix
Worksheets("Customer Scorecard").Range("K64:U79").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("B116")

'Copy Track & Trace
Worksheets("Account Data").Range("K6:O15").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("Q84")

'Copy Domestic Parcels
Worksheets("Account Data").Range("K2132").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("Q99")

'Copy Cost Mitigation Table
Worksheets("Cost Savings Pivots").Range("P7:U39").CopyPicture xlScreen, xlPicture
Worksheets("Copy Charts").Paste _
Destination:=Worksheets("Copy Charts").Range("Q23")

For Each myObject In mySheet.ChartObjects
Set myChart = myObject.Object
myChart.Export TargetFolder & "\" & myObject.Name & "." & Format, Format, False
Next

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