![]() |
#5
|
||||
|
||||
![]()
Try the following, which loops through all the story ranges in the document.
Code:
Sub DraftStampsDelete_25_0303_1525() Dim oStory As Range Dim sShape As Shape Dim strText As String Dim i As Integer For Each oStory In ActiveDocument.StoryRanges For i = oStory.ShapeRange.Count To 1 Step -1 Set sShape = oStory.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 If oStory.StoryType <> wdMainTextStory Then While Not (oStory.NextStoryRange Is Nothing) Set oStory = oStory.NextStoryRange For i = oStory.ShapeRange.Count To 1 Step -1 Set sShape = oStory.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 Wend End If Next oStory lbl_Exit: Set oStory = Nothing Set sShape = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
wlcdo2 | Excel Programming | 2 | 02-22-2017 05:10 PM |
![]() |
Cosmo | Word | 1 | 06-19-2014 01:09 PM |
While loop not working right | Cbrehm | Excel Programming | 0 | 05-11-2011 11:05 AM |
![]() |
SueK | PowerPoint | 1 | 01-20-2011 04:30 AM |
![]() |
stepper | PowerPoint | 2 | 01-13-2011 12:44 PM |