Well, I tested the macro and it works perfectly on all body pages of the document and the headers in the first section, but it doesn't touch any section 2+ headers. I've been unable to figure out why.
I tried to rework the macro so that it iterates through just the body first, then through just the headers (it's extremely unlikely that users would ever put the draft box in any other stories but the body and header), but this attempt also failed. Here, I tried to emulate the pattern in Andrew's code: you've got a range of shapes, then you've got an individual shape in the range to inspect, then you test/delete, then iterate backwards:
Code:
For i = rngStoryRange.ShapeRange.Count To 1 Step -1
Set sShape = rngStoryRange.ShapeRange(i)
'...do the things
Next i 'Next sShape in the current range
...but I can't for the life of me figure out how to have a range of shapes within the header so that I can then go through each individual shape.
My hope is that there's a simple solution to this. That said, I'm providing a failed second attempt to get this to work below; it does not include my attempts to set a range of shapes, then go through each shape. But you can see that I tried to have two loops: one for the body and one for the headers.
I'm also attaching a test doc that has multiple draft boxes in multiple sections.
Code:
Sub DraftStampsDelete_25_0303_1525()
Dim sShape As Shape
Dim strText As String, i As Integer
For i = ActiveDocument.Sections.Count To 1 Step -1
For Each sShape In ActiveDocument.Shapes
If sShape.TextFrame.HasText Then
strText = sShape.TextFrame.TextRange.Text
If UCase(Left(strText, 5)) = "DRAFT" Then sShape.Delete
End If
Next sShape
Next i
For i = ActiveDocument.Sections.Count To 1 Step -1
For Each sShape In ActiveDocument.Sections(i).Headers(wdHeaderFooterPrimary).Shapes
If sShape.TextFrame.HasText Then
strText = sShape.TextFrame.TextRange.Text
If UCase(Left(strText, 5)) = "DRAFT" Then sShape.Delete
End If
Next sShape
Next i
End Sub
Thank you.