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
_______
"ryguy7272" <(E-Mail Removed)> wrote in message
news:B0DE9DA4-98E7-40E3-B658-(E-Mail Removed)...
>
> 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---
>
>
> --
> RyGuy
Similar Threads
