Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Programming / January 2008

Tip: Looking for answers? Try searching our database.

Copy/Paste Charts; Define Destination of Charts in PowerPoint

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
ryguy7272 - 23 Jan 2008 16:31 GMT
I found this snippet of code on the web (thanks JP):

Sub CopyChartsIntoPowerPoint()
''' COPY SELECTED EXCEL CHARTS INTO POWERPOINT
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim pptApp As PowerPoint.Application
Dim iShapeIx As Integer, iShapeCt As Integer
Dim myShape As Shape, myChart As ChartObject
Dim bCopied As Boolean

Set pptApp = GetObject(, "PowerPoint.Application")

If ActiveChart Is Nothing Then
   ''' SELECTION IS NOT A SINGLE CHART
   On Error Resume Next
   iShapeCt = Selection.ShapeRange.Count
   If Err Then
       MsgBox "Select charts and try again", vbCritical, "Nothing Selected"
       Exit Sub
   End If
   On Error GoTo 0
   For Each myShape In Selection.ShapeRange
       ''' IS SHAPE A CHART?
       On Error Resume Next
       Set myChart = ActiveSheet.ChartObjects(myShape.Name)
       If Not Err Then
           bCopied = CopyChartToPowerPoint(pptApp, myChart)
       End If
       On Error GoTo 0
   Next
Else
   ''' CHART ELEMENT OR SINGLE CHART IS SELECTED
   Set myChart = ActiveChart.Parent
   bCopied = CopyChartToPowerPoint(pptApp, myChart)
End If

Dim myPptShape As PowerPoint.Shape
Dim myScale As Single
Dim iShapesCt As Integer

''' BAIL OUT IF NO PICTURES ON SLIDE
On Error Resume Next
iShapesCt = pptApp.ActiveWindow.Selection.SlideRange.Shapes.Count
If Err Then
   MsgBox "There are no shapes on the active slide", vbCritical, "No Shapes"
   Exit Sub
End If
On Error GoTo 0

''' ASK USER FOR SCALING FACTOR
myScale = InputBox(Prompt:="Enter a scaling factor for the shapes
(percent)", _
   Title:="Enter Scaling Percentage") / 100

''' LOOP THROUGH SHAPES AND RESCALE "PICTURES"
For Each myPptShape In pptApp.ActiveWindow.Selection.SlideRange.Shapes
   If myPptShape.Name Like "Picture*" Then
       With myPptShape
           .ScaleWidth myScale, msoTrue, msoScaleFromBottom
           .ScaleHeight myScale, msoTrue, msoScaleFromBottom
       End With
   End If
Next

Set myChart = Nothing
Set myShape = Nothing
Set myPptShape = Nothing
Set pptApp = Nothing
End Sub

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
   oChart As ChartObject)
CopyChartToPowerPoint = False

oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture,
Size:=xlScreen
oPPtApp.ActiveWindow.View.Paste

CopyChartToPowerPoint = True
End Function

That part works fine, now I’m trying to define the destination of each chart
on the PPT slide.  I though it may be something like this:
PowerPointConn.ActivePresentation.Slides(SlideNumber).Shapes(1).Top = "85"
PowerPointConn.ActivePresentation.Slides(SlideNumber).Shapes(1).Left = "85"

However, it doesn't work.

Also, my charts are named Chart1, Chart2, and Chart3 now, but in the future
the charts may be deleted and recreated, so I’m wondering if there is a way
to define variables such as:

Dim MyChartObj

Then, define the destinations for these charts/objects.

Is this possible or just wishful thinking?

Regards,
Ryan---

Signature

RyGuy

Jon Peltier - 23 Jan 2008 21:09 GMT
In the function that actually pastes the chart:

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
   oChart As ChartObject)
 CopyChartToPowerPoint = False

 oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture, _
   Size:=xlScreen
 oPPtApp.ActiveWindow.View.Paste

 CopyChartToPowerPoint = True
End Function

you can name your charts. You might want to pass the name from the calling
sub.

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
   oChart As ChartObject, sShapeName as String)
 CopyChartToPowerPoint = False

 oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture, _
   Size:=xlScreen
 oPPtApp.ActiveWindow.View.Paste

 with oPPtApp.ActiveWindow.Selection.SlideRange.Shapes( _
     oPPtApp.ActiveWindow.Selection.SlideRange.Shapes.Count)
   .Name = sShapeName
 End With

 CopyChartToPowerPoint = True
End Function

Alternatively, you could pass the left and top properties to the function:

Function CopyChartToPowerPoint(oPPtApp As PowerPoint.Application, _
   oChart As ChartObject, dLeft as Double, dTop as Double)
 CopyChartToPowerPoint = False

 oChart.Chart.CopyPicture Appearance:=xlScreen, Format:=xlPicture, _
   Size:=xlScreen
 oPPtApp.ActiveWindow.View.Paste

 with oPPtApp.ActiveWindow.Selection.SlideRange.Shapes( _
     oPPtApp.ActiveWindow.Selection.SlideRange.Shapes.Count)
   .Left = dLeft
   .Top = dTop
 End With

 CopyChartToPowerPoint = True
End Function

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
Peltier Technical Services, Inc. - http://PeltierTech.com
_______

> I found this snippet of code on the web (thanks JP):
>
[quoted text clipped - 103 lines]
> Regards,
> Ryan---
ryguy7272 - 24 Jan 2008 20:04 GMT
It's an honor and a pleasure to see a true Excel 'guru' respond to one of my
posts.  Thanks for the info.  I'm going to use it, and keep it in a safe
place.  

As an alternative, I noticed the 'linking' technique works pretty well (and
it is great for non-gurus such as myself).  
http://pptfaq.com/FAQ00593.htm

Thanks,
Ryan--
Signature

RyGuy

> In the function that actually pastes the chart:
>
[quoted text clipped - 161 lines]
> > Regards,
> > Ryan---
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.