VBA Powerpoint

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

Thomas GrobsteinAsked: 2017-03-07

Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

Experts Exchange Solution brought to you by

Enjoy your complimentary solution view.

Get every solution instantly with Premium. Start your 7-day free trial.

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

LVL 14

Jamie GarrochPowerPoint Consultant & DeveloperCommented: 2017-03-07

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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial