VBA Powerpoint

Thomas Grobstein used Ask the Experts™

on 2017-03-07

Hey Community,

I need a VBA Code that selects and then deletes all shapes in a PowerPoint file that do not contain any text(/words).

I tried this Code:

Private Sub Test()

Dim sShapes As Shape

For Each sShapes In ActivePresentation.Slides.Range("SlideNamexxx")
If Not sShapes.TextFrame Is Nothing Then
sShapes.Delete
Next sShapes
End If
End Sub

The basic idea is that I ungrouped a smart art and would like to deleted the shapes in which I didn't write any text.

Thanks in Advance

Thomas

Try this:

Option Explicit

' PowerPoint macro to delete shapes that support text but have no text
' Notes : Excludes palceholders
' Written by : Jamie Garroch of YOUpresent Ltd.
' Dependencies : None
Public Sub DeleteShapesWithoutText()
  Dim oSld As Slide
  Dim oGrpItem As Shape
  Dim x As Long, y As Long
  For Each oSld In ActivePresentation.Slides
    With oSld.Shapes
      ' Count backwards in collections when deleting from them
      For x = .Count To 1 Step -1
        Select Case .Item(x).Type
          Case msoAutoShape, msoFreeform
            If IsShapeEmpty(.Item(x)) Then .Item(x).Delete
          ' Recurse through shapes within groups
          Case msoGroup
            With .Item(x).GroupItems
              For y = .Count To 1 Step -1
                Select Case .Item(y).Type
                  Case msoAutoShape, msoFreeform
                    If IsShapeEmpty(.Item(y)) Then .Item(y).Delete
                End Select
              Next
            End With
        End Select
      Next
    End With
  Next
End Sub

Private Function IsShapeEmpty(oShp As Shape) As Boolean
  If oShp.HasTextFrame Then
    If oShp.TextFrame.TextRange.Text = "" Then IsShapeEmpty = True
  End If
End Function

Open in new window

VBA Powerpoint

Premium Content

Premium Content

Explore our Suite of Services