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:
Who is Participating?

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

x
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.

Jamie GarrochPowerPoint Consultant & DeveloperCommented:
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

0

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
Thomas GrobsteinAuthor Commented:
Perfect!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.