Removing a named object

[Maddy]

Hi,

I have a code that adds a 'DRAFT' tag to each slide in the powerpoint (works fine), I want to have another button that then removes it, but it is not working.... I have added both bits of code below, any help appreciated!


Sub Button3()
On Error Resume Next
' Usage: Add DRAFT to each slide
Dim Sld As Slide
Dim shp As Shape


For Each Sld In ActivePresentation.Slides
Set shp = Sld.Shapes.AddShape(Type:=msoShapeOval, _
Left:=700, Top:=30, width:=100, height:=30)
shp.IncrementRotation 28
shp.Name = "DRAFT"
shp.Line.Weight = 3
shp.Line.ForeColor.RGB = RGB(195, 12, 62)
shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
shp.TextFrame.TextRange.Font.Color.RGB = RGB(195, 12, 62)
shp.TextFrame.TextRange.Characters.Text = "DRAFT"
shp.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
shp.TextFrame2.VerticalAnchor = msoAnchorMiddle
shp.TextFrame2.TextRange.Font.Size = 14
Next Sld
End Sub



Sub Button4()
On Error Resume Next
' Usage: Remove DRAFT tag
Dim Sld As Slide
Dim shp As Shape
For Each Sld In ActivePresentation.Slides
If shp.Name = "DRAFT" Then
shp.Delete
End If
Next Sld
End Sub

Thank you,
Madeleine

[John Wilson]

Try this:


Sub Button3()

On Error Resume Next
' Usage: Add DRAFT to each slide
Dim Sld As Slide
Dim shp As Shape
For Each Sld In ActivePresentation.Slides
Set shp = Sld.Shapes.AddShape(Type:=msoShapeOval, _
Left:=700, Top:=30, Width:=100, Height:=30)
shp.IncrementRotation 28
shp.Name = "DRAFT"
shp.Line.Weight = 3
shp.Line.ForeColor.RGB = RGB(195, 12, 62)
shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
shp.TextFrame.TextRange.Font.Color.RGB = RGB(195, 12, 62)
shp.TextFrame.TextRange.Characters.Text = "DRAFT"
shp.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
shp.TextFrame2.VerticalAnchor = msoAnchorMiddle
shp.TextFrame2.TextRange.Font.Size = 14
Next Sld
End Sub


Sub Button4()
On Error Resume Next
' Usage: Remove shapes
Dim Sld As Slide
Dim L As Long
For Each Sld In ActivePresentation.Slides
For L = Sld.Shapes.Count To 1 Step -1
If Sld.Shapes(L).Name = "DRAFT" Then Sld.Shapes(L).Delete
Next L
Next Sld
End Sub

[SamT]

John, do Slide Shapes have to be deleted in reverse order? Or did you do that because the DRAFT Shape was or is near the last one created?

Would this work?

Sub Button4()
' Removes DRAFT tag shape
Dim Sld As Slide
Dim shp As Shape

On Error Resume Next
For Each Sld In ActivePresentation.Slides
.Shapes("DRAFT").Delete
Next Sld
End Sub

[John Wilson]

Your code would work if there was only one shape named "DRAFT". This might be the case but often I find that people run the add code several times. If there are more only the first will be deleted.

If you delete shapes in a loop you should always go in reverse order because if say you are looking at shapes 1 to 5 and delete number 1 first - shape 2 is now shape 1 and might not be deleted Not easy to explain but reverse order is always good!

[John Wilson]

Your code would work if there was only one shape named "DRAFT". This might be the case but often I find that people run the add code several times. If there are more only the first will be deleted.

If you delete shapes in a loop you should always go in reverse order because if say you are looking at shapes 1 to 5 and delete number 1 first shape 2 is now shape 1 and might not be deleted Not easy to explain but reverse order is always good!

Also the code (including mine) doesn't actually add a TAG. I would do this as it makes it difficult for anyone to remove the tag without code. People can change the name easily.


Sub Button3()

On Error Resume Next
' Usage: Add DRAFT to each slide
Dim Sld As Slide
Dim shp As Shape
For Each Sld In ActivePresentation.Slides
Set shp = Sld.Shapes.AddShape(Type:=msoShapeOval, _
Left:=700, Top:=30, Width:=100, Height:=30)
shp.IncrementRotation 28
shp.Tags.Add "DRAFT", "YES"
shp.Line.Weight = 3
shp.Line.ForeColor.RGB = RGB(195, 12, 62)
shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
shp.TextFrame.TextRange.Font.Color.RGB = RGB(195, 12, 62)
shp.TextFrame.TextRange.Characters.Text = "DRAFT"
shp.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
shp.TextFrame2.VerticalAnchor = msoAnchorMiddle
shp.TextFrame2.TextRange.Font.Size = 14
Next Sld
End Sub


Sub Button4()
On Error Resume Next
' Usage: Remove shapes
Dim Sld As Slide
Dim L As Long
For Each Sld In ActivePresentation.Slides
For L = Sld.Shapes.Count To 1 Step -1
If Sld.Shapes(L).Tags("DRAFT") = "YES" Then Sld.Shapes(L).Delete
Next L
Next Sld
End Sub

[SamT]

I see. I didn't know PP would accept two objects with the same name in the same collection.

[John Wilson]

It does. I have been shouting at the MSFT programmers for years about how stupid this is!

[Paul_Hossler]

It does. I have been shouting at the MSFT programmers for years about how stupid this is!

Well, since they don't even have a .Name property for MS Word Content Controls at all (only .Title and .Tag, neither of which need to be unique, it sort of averages out :banghead:

16289