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

 

[tourgis2000]

I have run this code adapted to shapes as follows and I get the following:

Sub xyz1()

    Dim sh As Object
    Dim sp As Shape
     
     ' shapes on worksheets
    For Each sh In Worksheets
        For Each sp In sh.Shapes
            Debug.Print sp.Name, "shapes on worksheets"
        Next sp
    Next sh
    End Sub

And I get the following in the immediate window:

Button 1      shapes on worksheets
ChartChannelMix             shapes on worksheets
ChartSpotlengthMix          shapes on worksheets
ChartDayOfWeekMix           shapes on worksheets
ChartProgrammeMix           shapes on worksheets
ChartAffinity shapes on worksheets
ChartPIBMix   shapes on worksheets
ChartDaypartMix             shapes on worksheets
ChartGenreMix shapes on worksheets
Button 1      shapes on worksheets
Button 3      shapes on worksheets
Group Box 4   shapes on worksheets
Button 6      shapes on worksheets
Button 8      shapes on worksheets
Button 9      shapes on worksheets
Button 10     shapes on worksheets
Button 11     shapes on worksheets
Button 12     shapes on worksheets
Button 13     shapes on worksheets
Button 14     shapes on worksheets
Button 15     shapes on worksheets
Button 16     shapes on worksheets
Button 17     shapes on worksheets
Button 20     shapes on worksheets
Button 21     shapes on worksheets
Button 22     shapes on worksheets
Group Box 23  shapes on worksheets
ChartChannelMixS            shapes on worksheets
ChartSpotlengthMixS         shapes on worksheets
ChartDayOfWeekMixS          shapes on worksheets
ChartDaypartMixS            shapes on worksheets
ChartPIBMixS  shapes on worksheets
ChartGenreMixS              shapes on worksheets
ChartProgrammeMixS          shapes on worksheets
ChartAffinityS              shapes on worksheets
Group Box 19  shapes on worksheets
Button 20     shapes on worksheets
Button 21     shapes on worksheets
Button 22     shapes on worksheets
Button 23     shapes on worksheets
Button 24     shapes on worksheets
Button 25     shapes on worksheets
Button 26     shapes on worksheets
Button 27     shapes on worksheets
Button 28     shapes on worksheets
Button 29     shapes on worksheets
Button 30     shapes on worksheets
Button 31     shapes on worksheets
Button 32     shapes on worksheets
Button 33     shapes on worksheets
Button 34     shapes on worksheets
Button 35     shapes on worksheets
Group Box 36  shapes on worksheets
ChartChannelMixT            shapes on worksheets
ChartSpotlengthMixT         shapes on worksheets
ChartDayOfWeekMixT          shapes on worksheets
ChartDaypartMixT            shapes on worksheets
ChartPIBMixT  shapes on worksheets
ChartGenreMixT              shapes on worksheets
ChartProgrammeMixT          shapes on worksheets
ChartAffinityT              shapes on worksheets
Group Box 1   shapes on worksheets
Button 2      shapes on worksheets
Button 3      shapes on worksheets
Button 4      shapes on worksheets
Button 5      shapes on worksheets
Button 6      shapes on worksheets
Button 7      shapes on worksheets
Button 8      shapes on worksheets
Button 9      shapes on worksheets
Button 10     shapes on worksheets
Button 11     shapes on worksheets
Button 12     shapes on worksheets
Button 13     shapes on worksheets
Button 14     shapes on worksheets
Button 15     shapes on worksheets
Button 16     shapes on worksheets
Button 17     shapes on worksheets
Group Box 18  shapes on worksheets
ChartGrossSpend             shapes on worksheets
ChartAvgSpotlength          shapes on worksheets
ChartSoS      shapes on worksheets
ChartSponsorshipGRPs        shapes on worksheets
ChartGrossSpendCampaign     shapes on worksheets
ChartAvgSpotlengthCampaign  shapes on worksheets
ChartSoSCampaign            shapes on worksheets
ChartGrossSpendSponsorship  shapes on worksheets
ChartAvgSpotlengthSponsorship             shapes on worksheets
ChartSoSSponsorship         shapes on worksheets
Group Box 4   shapes on worksheets
Button 5      shapes on worksheets
Button 6      shapes on worksheets
Button 11     shapes on worksheets
Button 14     shapes on worksheets
Group Box 15  shapes on worksheets
Button 16     shapes on worksheets
Button 17     shapes on worksheets
Button 18     shapes on worksheets
Button 19     shapes on worksheets
Button 20     shapes on worksheets
ChartWeeks    shapes on worksheets
ChartSeasons  shapes on worksheets
ChartClutter  shapes on worksheets
Button 3      shapes on worksheets
Button 4      shapes on worksheets
Button 12     shapes on worksheets
Group Box 14  shapes on worksheets
Group Box 15  shapes on worksheets
Button 16     shapes on worksheets
Button 17     shapes on worksheets
Button 18     shapes on worksheets
Button 19     shapes on worksheets
Button 20     shapes on worksheets

How do I stop my code from pasting 'Button *' and 'Group Box *' ?

Thanks,

Martin

 

[Kenneth Hobson]

You wanted other shapes other than charts?

To get the first 5 characters for a prefix:

Dim sPrefix as String, Prefix as String
Prefix = "chart"
For Each sp In sh.Shapes
  If LCase(Left(sp.Name,5)) = Prefix, sp.Name 'May be a Chart?
Next sp

 

[Sal Paradise]

If sp.Name Is Like "Button*" Then
    Next sp
End If

Add that to the loop, see if it works.

 

[tourgis2000]

Hi Kenneth and Sal,

Thanks to your hints I now have this code attached to a command button:

Private Sub CommandButton1_Click()
Dim objPPT As Object
    Dim intSlide As Integer
    Dim sp As Shape
    Dim Prefix As String
    Set objPPT = CreateObject("Powerpoint.application") 'Start PowerPoint
    objPPT.Visible = True
    objPPT.Presentations.Open ThisWorkbook.Path & "\Presentation.pptx"
    objPPT.ActiveWindow.ViewType = 1 'ppViewSlide
    'Find the charts and/or shapes with names beginning "chart"
    Prefix = "chart"
        For Each sp In ActiveSheet.Shapes
            If LCase(Left(sp.Name, 5)) = Prefix Then
                intSlide = intSlide + 1
            sp.Copy 'Copy the objects
                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
            End If
        Next sp
    objPPT.FileDialog(msoFileDialogSaveAs).Show
    Set objPPT = Nothing
    Set sp = Nothing
    Unload Me
End Sub

This was realy useful in helping me to address the difficulties of working with both charts and grouped objects. I programmatically named both my charts and my chart/picture groups and this copies only those named shapes, with a prefix of "Chart" to PowerPoint.

Thanks again.

Martin