View Single Post
 
Old 03-03-2018, 01:48 AM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2013
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,164
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

The first problem is the order you are stepping through when you might delete a textbox. The way your code is written you are saying: Take a line of objects, if the first object is bad, remove it and step to the object #2. BUT if you remove the first object, all the remaining objects move up the list by one spot. So potentially, you could delete only every second shape if all started with Draft. You can avoid this trap by starting at the back of the line and moving forward.

Another potential issue is that a text box and a shape with a text frame might be two different things in VBA but could appear to the user to be the same.

The next problem is that InStr doesn't return 1 if a text box contains DRAFT, it returns the position the string starts at. I"m not sure if InStr is Case Sensitive so that might also cause a non-hit when you expect a hit.
Code:
Sub DraftStampDelete0301()

' This macro removes all text boxes containing "DRAFT" from a document.

' StoryRanges loop by macropod -- http://www.vbaexpress.com/forum/archive/index.php/t-27391.html
' Shapes code adapted from https://www.experts-exchange.com/questions/27274592/Word-VBA-access-Text-box-in-header.html

    Dim pRange As Range ' The story range, to loop through each story in the document
    Dim sShape As Shape ' For the text boxes, which Word considers shapes
    Dim strText As String, i As Integer

    For Each pRange In ActiveDocument.StoryRanges    'Loop through all of the stories
      For i = pRange.ShapeRange.Count To 1 Step -1
        Set sShape = pRange.ShapeRange(i)
        If sShape.TextFrame.HasText Then
          strText = sShape.TextFrame.TextRange.Text
          If UCase(Left(strText, 5)) = "DRAFT" Then sShape.Delete
        End If
      Next i
    Next pRange
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote