Copying selections to PowerPoint with VBA

[tourgis2000]

Hi,

I am trying to write a routine (via two comboboxes) that will enable users to select a choice of charts from one of three possible worksheets and have the charts on the selected sheet copied to PowerPoint. My difficulties are these:

a. I cannot determine how to pass the selections to Excel (see b. as well)

b. In some instances my charts are actually groups of a chart and a picture. Can anyone help with how I should reference these? They are obviously not ChartObjects: when I use the macro recorder all I get is a range.

Thanks,

Martin

 

[Sal Paradise]

It may be easiest to have a chart sheet that reflects whatever chart you want to have in PowerPoint, then just link that chart to powerpoint manually. That way you can keep all the fancy change stuff in Excel (which is much more flexible in general), and keep the PowerPoint simple.

Additionally, if you have pictures in a chart sheet, and link the chart sheet to Excel, the images/textboxes/whatever will also be linked in PPT. Very handy, no?

 

[tourgis2000]

Hi Sal Paradise,

Thanks for your reply; normally I would do as you suggest. However in this instance the Excel file is a template that is saved under another name by the user, hence links won't function. Also I have had significant difficulties with links in Excel 2007 and PowerPoint 2007 so I would prefer to get the method I have outlined working.

Martin

 

[tourgis2000]

Further to this I have tried to simplify the process by creating a command button on each of the three worksheets that will dump each chart and grouped object (chart+picture) on a new PowerPoint slide. I tried using the code written by Jon Peltier below but it doesn't seem to wotk with Excel/PowerPoint 2007.

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, msoScaleFromMiddle
            .ScaleHeight myScale, msoTrue, msoScaleFromMiddle
        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

Has anyone been able to amend this? Ideally I need to paste charts and groups as they are and to offer the option of pasting them as pictures as well.

Thanks

Martin

 

[tourgis2000]

Hi all,

I have no hair left to tear out over this. Can anyone help me with copying the chart+picture groups in VBA?

Thanks,

Martin

 

[tourgis2000]

I have managed to come up with this code, which is a slight amendment to code I found elsewhere (thanks to whoever that was):

Private Sub CommandButton1_Click()
Dim objPPT As Object
Dim intSlide As Integer
    Set objPPT = CreateObject("Powerpoint.application")
    objPPT.Visible = True
    objPPT.Presentations.Open ThisWorkbook.Path & "\Presentation.pptx"
    objPPT.ActiveWindow.ViewType = 1 'ppViewSlide
        For Each Shape In ActiveSheet.Shapes
        intSlide = intSlide + 1
        Shape.Copy
        If intSlide > objPPT.Presentations(1).Slides.Count Then
        objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.Presentations(1).Slides.Add(Index:=intSlide, Layout:=12).SlideIndex
        End If
        objPPT.ActiveWindow.View.Paste
        Next
objPPT.FileDialog(msoFileDialogSaveAs).Show
Set objPrs = Nothing
Set objPPT = Nothing
Unload Me

The only problem with this is that is pastes ALL the shapes in the worksheet onto individual slides not just the ones I want: I have a number of control buttons on the page and they are pasted as well. CAn anyone help me to finish this off by adding a routine to delete the slides I don't want?

Thanks,

Martin

 

[Kenneth Hobson]

Why not just add the ones that you want? Maybe you named the shapes with a certain prefix? That would make it easier to get just the ones you need. Otherwise, some criteria is needed to know which ones to delete. I prefer the horse before cart method myself.

If you can make a real simple xls and regular ppt file, we can more easily help by testing it. If needed, you can post the files to a free shared like 4shared.com.

 

[tourgis2000]

Hello Kenneth,

You idea is a good one - I can give every chart a prefix easily enough. How would I reference and loop through shapes with a prefix of 'Cht' on the active sheet?

Thanks,

Martin

 

[Kenneth Hobson]

See if this gives you an idea:

Sub x()
    Dim sh As Object
    Dim co As ChartObject
     
     ' charts on worksheets
    For Each sh In Worksheets
        For Each co In sh.ChartObjects
            Debug.Print co.Name, "charts on worksheets"
        Next co
    Next sh
     
     ' ChartSheets and charts on chartsheet
    For Each sh In Charts
        Debug.Print sh.Name
        For Each co In sh.ChartObjects
            Debug.Print co.Name, "charts on chartsheet"
        Next co
    Next sh
     
End Sub

 

[tourgis2000]

Thank you Kenneth,

If I am correct, this routine examines each ChartObject and determines the name of the ChartObject. I am afraid that I don't know where to go after that. Each worksheet(there are 3) contains between 4 and 7 embedded ChartObjects and/or Shapes (there are no chartsheets) that need to be copied to PowerPoint. The names will be constant and I can prefix them all with 'Cht'. All other shapes etc. will have different names.

Martin