Excel Treating VBA button as Shape

Question

I created a macro to cycle through multiple columns, create a scatter plot, export that plot to powerpoint on a specific slide, delete the original chart in excel and repeat on a loop.

The problem arises when I include a Macro Button as it treats the button as a Shape and therefore it export a picture of the button to the powerpoint as well. Is there another way to define the button as something other than a shape so that this will not occur?

Sub Export_To_PowerPoint_JAH()
' Keyboard Shortcut: Ctrl+Shift+M

On Error Resume Next

Dim Shape As Shape
Dim PP As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation

'Create a PP application and make it visible
Set PP = New PowerPoint.Application
PP.Visible = msoCTrue

'Open the presentation you wish to copy to
'Set PPpres = PP.Presentations.Open("C:\Users\jh307836\Documents\Excel Test.pptx")
Set PPpres = PP.Presentations.Open(Range("B1").Value)

i = 0
A = 0

Do

If Cells(i + 5, 3) = "" Then
Exit Do
End If

'Create Chart
'----------------------------------------------------
'Create Range for Y
    Dim rng1Y As Range, rng2Y As Range
    Dim Y_Range As Range

With ThisWorkbook.Sheets("Scatter Plots")
    Set rng1Y = .Cells(2, A + 5)
    Set rng2Y = .Cells(2, A + 5).End(xlDown)

        Set Y_Range = .Range(rng1Y.Address & ":" & rng2Y.Address)
        Y_Range.Select

    End With

' Create Range for X
    Dim rng1X As Range, rng2X As Range
    Dim X_Range As Range

With ThisWorkbook.Sheets("Scatter Plots")
    Set rng1X = .Cells(2, A + 6)
    Set rng2X = .Cells(2, A + 6).End(xlDown)

        Set X_Range = .Range(rng1X.Address & ":" & rng2X.Address)
        X_Range.Select

    End With

'Build chart

Dim Sh As Worksheet
Dim chrt As Chart

Set chrt = Nothing
Set Sh = ActiveWorkbook.Worksheets("Scatter Plots")
Set chrt = Sh.Shapes.AddChart.Chart
With chrt

        'Data
        .ChartType = xlXYScatter
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Name = "=""Scatter Chart"""
        .SeriesCollection(1).XValues = X_Range
        .SeriesCollection(1).Values = Y_Range


        'Titles
        .HasTitle = True
        .ChartTitle.Characters.Text = Cells(i + 5, 2).Value
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Cells(1, A + 6).Value
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Cells(1, A + 5).Value
        .Axes(xlCategory).HasMajorGridlines = True

        'Formatting
        .Axes(xlCategory).HasMinorGridlines = False
        .Axes(xlValue).HasMajorGridlines = True
        .Axes(xlValue).HasMinorGridlines = False
        .HasLegend = False

'-----------------------------------------------------
'Hide Button From Shape set
ActiveSheet.Shapes("Button 1").Visible = False
'Set the shape you want to copy (1) means current plot "random"
Set Shape = Worksheets("Scatter Plots").Shapes(1)

'Copy the shape
Shape.Copy

'Define Slide #
Z = Cells(i + 5, 3).Value

'Paste on the "Z" slide
'PPpres.Slides(Z).Shapes.Paste

'Pastes Shape to Z slide and Repositions/ Resizes shape
With PPpres.Slides(Z)
    .Shapes.Paste
    With .Shapes(.Shapes.Count)
        .LockAspectRatio = msoTrue
        .Left = Range("B20").Value
        .Top = Range("B21").Value
        .Height = Range("A17").Value
    End With
End With

'Deletes last shape
Shape.Delete

'Clears shape from clipboard
Set Shape = Nothing

i = i + 1
A = A + 3

End With

Loop

MsgBox ("Please Check Your Powerpoint")

End Sub

Answer 1

• Remove On Error Resume Next . This is quite dangerous, as it ignores the errors on your code.

• The Shape is copied with Shape.Copy .

Thus, remove this line and write:

If Not IsItButton(shape.name) Then Shape.Copy

To make it work, add this function:

Public Function IsItButton(nameStr As String) As Boolean    
    IsItButton = CBool(lcase(Left(nameStr, Len("button"))) = "button")    
End Function