Thread: [Solved] vba control of shading
View Single Post
 
Old 04-08-2021, 12:54 AM
macropod's Avatar
macropod macropod is offline Windows 10 Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,200
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

Quote:
Originally Posted by Tony View Post
I'm sorry if I'm missing something, but I don't see how this applies to my question ("Is there a way in vba to find the range start and end points for each shaded text?")
The simple answer is that every iteration of a Find shifts points to a range that spans whatever is found. Hence, every instance of the shading start/end points are being identified. You can see that with code like the following, which reports the start/end points of yellow-shaded content. Note the extra code required for handling tables and exiting at the end of the document.
Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Font.Shading.BackgroundPatternColor = wdColorYellow
  End With
  Do While .Find.Execute
    MsgBox .Start & vbTab & .End
    If .Information(wdWithInTable) = True Then
      If .End = .Cells(1).Range.End - 1 Then
        .End = .Cells(1).Range.End
        .Collapse wdCollapseEnd
        If .Information(wdAtEndOfRowMarker) = True Then
          .End = .End + 1
        End If
      End If
    End If
    If .End = ActiveDocument.Range.End Then Exit Do
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub
One thing you will likely notice is shaded ranges spanning multiple paragraphs are not treated as a single unit.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote