Delete TextBox in PPT2010

[nsalyani]

Hi there,

THE REQUIREMENT in PPT 2010:

I have a presentation with 2 slides. Each slide has 4 autoshapes. Each autoshape has a textbox in it and each textbox content is unique from the other.

I am trying to run a macro when an action button is clicked on that slide. The macro should check for 2 textboxes which have certain strings in them and then delete those two textboxes from the autoshape so that the two autoshapes become blank.

THE ERROR

The error I am encountering is that the macro is deleting all the textboxes in the autoshapes on a slide.

However, interestingly enough, when I end my slideshow, I notice that that the textboxes I want deleted are indeed deleted and the other two textboxes are visible (BUT once the slideshow is closed and I go back to edit mode).

Here is the sample code:

Dim ss1 as Powerpoint.slide

For Each ss1 In ActivePresentation.Slides
For Each shp1 In ss1.Shapes
If shp1.Type = msoTextBox Then
If StrComp(shp1.TextFrame.TextRange, "D:", vbTextCompare) = 0 Then shp1.Delete
End If
Next shp1
Next ss1

For Each ss2 In ActivePresentation.Slides
For Each shp2 In ss2.Shapes
If shp2.Type = msoTextBox Then
If StrComp(shp2.TextFrame.TextRange, "B:", vbTextCompare) = 0 Then shp2.Delete
End If
Next shp2
Next ss2


Any help would be appreciated!!!

Thanks

[John Wilson]

Not sure what you mean by a shape with a textbox. Shapes can have a TextFrame but not a TextBox (unless you mean you placed a textbox over a shape)

Anyway does this work?

Sub zap()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
With oshp.TextFrame.TextRange
If .Text = "D:" Or .Text = "B:" Then .Text = ""
End With
End If
Next oshp
Next osld
End Sub

[nsalyani]

Thanks for your response. This does the job! and fyi i meant textbox in a shape. But I realized I could add a textframe in a shape as opposed to placing a textbox in there.





Not sure what you mean by a shape with a textbox. Shapes can have a TextFrame but not a TextBox (unless you mean you placed a textbox over a shape)

Anyway does this work?

Sub zap()
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
With oshp.TextFrame.TextRange
If .Text = "D:" Or .Text = "B:" Then .Text = ""
End With
End If
Next oshp
Next osld
End Sub

[james5478]

Hi John and nsalyani.

I have a situation related to the below where I have a macro in powerpoint to add a shape(textframe) at the bottom of each slide to show "page x of y". In addition to the macro which adds the shape to each slide, I need to have a macro to delete it so I used the below code.

So here's where the interesting piece begins-in the powerpoint I am working in, the code to add the shape works, but the code to delete them doesn't. However, I opened a blank powerpoint and inserted a few slides to test and both macros run fine. I am using ppt 2007 and both the working file and test file are 2007. Below is the code I am working with. Any suggestions on why this is happening and what solutions exist?

Thank You.

Option Explicit
Function TotalSlides() As Long
Dim objPresentation As Presentation
Set objPresentation = Application.Presentations(1)
TotalSlides = objPresentation.Slides.Count
End Function

Sub AddPageNumbers()
Dim oSlide As Slide
Dim oShape As Shape
Dim x As Long
Dim ThisTotalCount As Long
ThisTotalCount = TotalSlides

For Each oSlide In ActivePresentation.Slides
x = oSlide.SlideIndex
Set oShape = oSlide.Shapes.AddTextBox(msoTextOrientationHorizontal, 500.15, 738, 75, 28)
oShape.TextFrame.TextRange.Text = "Page " & x & " of " & ThisTotalCount
oShape.TextEffect.FontName = "Calibri"
oShape.TextEffect.FontSize = 9
oShape.TextEffect.Alignment = msoTextEffectAlignmentRight

Next
End Sub

Sub RemovePageNumbers()
Dim osld As Slide
Dim oshp As Shape

For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
With oshp.TextFrame.TextRange
If oshp.Left = 500.15 And oshp.Top = 738 Then oshp.Delete
End With
End If
Next oshp
Next osld
End Sub

[John Wilson]

This doesn't make any sense. You are not doing anything WITH the textrange here.

With oshp.TextFrame.TextRange
If oshp.Left = 500.15 And oshp.Top = 738 Then oshp.Delete
End With
I would never rely on the left and Top to find a shape, just name it. Also your Left & Top put the number off my slide. Maybe you had a portrait slide but I have added a function to check.

Try this:

Option Explicit

Function TotalSlides(opres As Presentation) As Long
TotalSlides = opres.Slides.Count
End Function
Function getLeft(opres As Presentation) As Single
getLeft = opres.PageSetup.SlideWidth - 100
End Function
Function getTop(opres As Presentation) As Single
getTop = opres.PageSetup.SlideHeight - 40
End Function

Sub AddPageNumbers()
Dim oSlide As Slide
Dim oShape As Shape
Dim x As Long
Dim thisLeft As Single
Dim thisTop As Single
Dim thisTotalCount As Long
thisTotalCount = TotalSlides(ActivePresentation)
thisLeft = getLeft(ActivePresentation)
thisTop = getTop(ActivePresentation)
For Each oSlide In ActivePresentation.Slides
x = oSlide.SlideIndex
Set oShape = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, thisLeft, thisTop, 75, 28)
oShape.TextFrame.TextRange.Text = "Page " & x & " of " & thisTotalCount
oShape.TextEffect.FontName = "Calibri"
oShape.TextEffect.FontSize = 9
oShape.TextEffect.Alignment = msoTextEffectAlignmentRight
oShape.Name = "Slidexx"
Next
End Sub

Sub RemovePageNumbers()
Dim osld As Slide
On Error Resume Next
For Each osld In ActivePresentation.Slides
osld.Shapes("Slidexx").Delete
Next osld
End Sub
You will see that I have no loop in the delete sequence.

If you have a circumstance where a loop (as you used) is vital then it is important that you start the loop from the END.

e.g.

Sub loop_demo()
Dim L As Long
Dim osld as Slide
For L = osld.Shapes.Count To 1 Step -1
If whatever Then osld.Shapes(L).Delete
Next L
End Sub
To "get this" you need to think like a PC!

Suppose you loop through Shapes 1 to 5 (forwards)

You decide to delete Shape 3.

When you get to Shape 5 - there is no Shape 5 because now there are only 4 Shapes!
PC's are stupid this will confuse them, you'll either not delete Shapes that should be or just crash.