View Single Post
 
Old 08-24-2012, 07:55 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi netchie,

That approach isn't going to work because the content you're looking for isn't in Word's document layer, but in a series of independent frames overlaying it. So, although you can find the text, you can't do anything with the related content.

What you need to do after finding the text is to check every frame on that page and, if it has the text you're looking for, work out where all the other frames are that relate to it visually so that you can delete them. Ultimately, it's all trial and error.

The macro below looks like it will do what you want with the sample you posted. Basically, it deletes any frames whose tops are located within -4 to +36 points vertically from the frame containing the found text. You may need to adjust those values.
Code:
Sub NoCorrelateRemove()
Application.ScreenUpdating = False
Dim i As Long, Rng As Range, sVpos As Single
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "No Color"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = .Duplicate.Information(wdActiveEndPageNumber)
  Set Rng = ActiveDocument.GoTo(What:=wdGoToPage, Name:=i)
  Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
    sVpos = 0
    With Rng
      For i = 1 To .Frames.Count
        If InStr(1, .Frames(i).Range.Text, "no color", vbTextCompare) Then
          .Frames(i).RelativeVerticalPosition = wdRelativeVerticalPositionPage
          sVpos = .Frames(i).VerticalPosition - 4
          Exit For
        End If
      Next
      For i = .Frames.Count To 1 Step -1
        With .Frames(i)
          If .VerticalPosition > (sVpos) Then
            If .VerticalPosition < (sVpos + 36) Then
              .Cut
            End If
          End If
        End With
      Next
    End With
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote