[Webinar] Streamline your web hosting managementRegister Today

x
?
Solved

PowerPoint 2007 Macro VBA to delete text box

Posted on 2010-04-01
9
Medium Priority
?
1,414 Views
Last Modified: 2013-11-10
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
0
Comment
Question by:andreyman3d2k
  • 5
  • 4
9 Comments
 
LVL 12

Expert Comment

by:jostrander
ID: 29368915
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
 
LVL 6

Author Comment

by:andreyman3d2k
ID: 29371272
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
 
LVL 12

Expert Comment

by:jostrander
ID: 29372898
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
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
LVL 12

Accepted Solution

by:
jostrander earned 2000 total points
ID: 29374049
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
 
LVL 12

Expert Comment

by:jostrander
ID: 29374202
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
 
LVL 6

Author Comment

by:andreyman3d2k
ID: 29375533
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
 
LVL 6

Author Closing Comment

by:andreyman3d2k
ID: 31710020
Phenomenal! Thanks so much!
0
 
LVL 12

Expert Comment

by:jostrander
ID: 29375764
Woohoo!  Happy to help :D

Thanks for the grade, and have a nice weekend (3 days for me)
Joe
0
 
LVL 6

Author Comment

by:andreyman3d2k
ID: 29376366
Nice! Enjoy it! Regular 2 days here, but I usually mentally check out on Fridays anyway : ))

Andrey
0

Featured Post

Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
In real business world data are crucial and sometimes data are shared among different information systems. Hence, an agreeable file transfer protocol need to be established.
This video teaches viewers how to add transitions to their Slideshows and how to set up timing for the transitions.
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …

608 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question