PowerPoint 2007 Macro VBA to delete text box

I would like a VBA macro the will delete the text box closest to the lower right-hand corner on each slide. Can this be done? Thanks!

Andrey
LVL 6
andreyman3d2kAsked:
Who is Participating?
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.

jostranderCommented:
This seems to work for me.  I'm having it check each field.  If the field top + field height is greater than or equal to the slide height, it deletes it.

I included some extra lines for playing around.  They are currently commented out.

Thanks,
Joe
Sub DeleteProjectNumber()
    Dim objSlide As Slide
    Dim objShape As Shape

    ' Get the slide height and width.
    intSlideHeight = ActivePresentation.PageSetup.SlideHeight
    intSlideWidth = ActivePresentation.PageSetup.SlideWidth
    
    For Each objSlide In ActivePresentation.Slides
        strDeleteMe = ""
        For Each objShape In objSlide.Shapes
            If objShape.Top > intMaxBottom Then
                intTop = objShape.Top
                If intTop + objShape.Height >= intSlideHeight Then
                    objShape.Delete
                End If
'                MsgBox "Field Name:  " & objShape.Name & vbCrLf & _
'                    "Slide Height:  " & intSlideHeight & vbCrLf & _
'                    "Top of field:  " & intTop & vbCrLf & _
'                    "Field Height:  " & objShape.Height & vbCrLf & _
'                    "Total:  " & intTop + objShape.Height
            End If
        Next
    Next

End Sub

Open in new window

0
andreyman3d2kAuthor Commented:
That didn't work for me, I have a feeling it might be because the project numbers are not in true text boxes but in placeholders on the slide master. Is it possible to make it delete either placeholders or text boxes on the lower right, whatever it happens to see?

Also, I am not quite clear on the logic of this:

 If intTop + objShape.Height >= intSlideHeight Then

does this mean that in order to be deleted, the text box has to be going off the slide on the bottom? Or off in the margin? Would it delete the page # place holders then too?

I attached some sample slide with our template, so you can see it in context.

Thanks again very much!

Andrey
ppt-example.ppt
0
jostranderCommented:
In our other macro (the one to add the textbox), the above macro should work fine.  I set the logic like that because the combined values were always greater than the height.  If you're curious, comment out the delete line and then uncomment those other lines and run it against a generic ppt with the textboxes added from the other macro.

Thanks for adding the sample presentation.  I'll take a look at that one and see if I can get it going for that one too.

0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

jostranderCommented:
I see what it is... I didn't realize you had a page number on the same level.

Just needed to add a check for horizontal placement.  

Please try this:

Sub DeleteProjectNumber()
    Dim objSlide As Slide
    Dim objShape As Shape

    ' Get the slide height and width.
    intSlideHeight = ActivePresentation.PageSetup.SlideHeight
    intSlideWidth = ActivePresentation.PageSetup.SlideWidth
    
    For Each objSlide In ActivePresentation.Slides
        strDeleteMe = ""
        For Each objShape In objSlide.Shapes
            If objShape.Top > intMaxBottom Then
                intTop = objShape.Top
                intLeft = objShape.Left
                If intTop + objShape.Height >= intSlideHeight Then
                    If intLeft + objShape.Width >= intSlideWidth Then
'Uncomment to show text
'                        MsgBox objShape.TextFrame.TextRange.Text
                        objShape.Delete
                    End If
                        
                End If
'Uncomment to show field data
'                MsgBox "Slide #:  " & objSlide.SlideIndex & vbCrLf & vbCrLf & _
'                    "Field Name:  " & objShape.Name & vbCrLf & _
'                    "Slide Height:  " & intSlideHeight & vbCrLf & _
'                    "Top of field:  " & intTop & vbCrLf & _
'                    "Field Height:  " & objShape.Height & vbCrLf & _
'                    "Height Total:  " & intTop + objShape.Height & vbCrLf & vbCrLf & _
'                    "Slide Width:  " & intSlideWidth & vbCrLf & _
'                    "Left of field:  " & intLeft & vbCrLf & _
'                    "Field Width:  " & objShape.Width & vbCrLf & _
'                    "Width Total:  " & intLeft + objShape.Width
            End If
        Next
    Next

End Sub

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
jostranderCommented:
I left in some extra stuff just for testing.  If you want to use it, you should comment out the objShape.Delete line first.

Hope it works for you,
Joe
0
andreyman3d2kAuthor Commented:
This is completely awesome!! Everything works, can't tell you how much I appreciate it, Joe. Saves everyone here a ton of work. Thanks again very much.

Andrey
0
andreyman3d2kAuthor Commented:
Phenomenal! Thanks so much!
0
jostranderCommented:
Woohoo!  Happy to help :D

Thanks for the grade, and have a nice weekend (3 days for me)
Joe
0
andreyman3d2kAuthor Commented:
Nice! Enjoy it! Regular 2 days here, but I usually mentally check out on Fridays anyway : ))

Andrey
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
Programming

From novice to tech pro — start learning today.