vba control of shading

Tony · #1 04-07-2021, 10:27 PM

I want to determine the range for all shaded (not highlighted) text in my document. The problem is that I don't know the colors of all the shades used. I've written some code to find those colors and their ranges, but it's messy and doesn't work well (see below). I have hundreds of documents I want to do this with.

I've read that typing CTRL-a, CTRL-q, CTRL-spacebar will remove all direct formatting, and when I do this all shades in the document disappear. I conclude they must all be direct formatting. This suggests they are not "styles" vba objects, and yet the Style listing of the user interface has entries for every shading (and other formatting).

The screenshot shows part of the document with the Styles and Style Inspector. I put my cursor on the word 'big' and then used the 'select all 154 instances" -- here the selected words show as gray, but the Style Inspector shows "Pattern: Solid (100%) (White)". But if I put my cursor in the pink text 'bar', I see "Pattern: Solid (100%) (Custom Color(RGB(255,191,255)))" I'm not interested in the White shaded text, but I am interested in all other colors. This Style list interface provides great control, but I need to use vba since I have many large, complex documents like this.

I've literally spent days on this and would appreciate any help.

here's some of the code I mentioned above:

Code:

Set wR = wDoc.Content
wR.Find.ClearFormatting
wR.Find.Font.Shading.BackgroundPatternColor = wdColorAutomatic
Set wF = wR.Find
With wF
  .Text = ""
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindStop
  .Format = True
End With
Do While wF.Execute = True
...[lots of code]...
Loop

gmayor · #2 04-07-2021, 11:14 PM

What is the aim of this exercise? If as your code implies you simply want to remove the shading then

Code:

Sub RemoveShading()
Dim oStory As Range
    For Each oStory In ActiveDocument.StoryRanges
        oStory.Font.Shading.BackgroundPatternColor = wdColorAutomatic
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                oStory.Font.Shading.BackgroundPatternColor = wdColorAutomatic
            Wend
        End If
    Next oStory
lbl_Exit:
    Set oStory = Nothing
    Exit Sub
End Sub

should do the job.
It is possible that there are story ranges that are not covered by the above code, but it will cover the ranges in most documents.
You could use the code as a custom process in conjunction with
Document Batch Processes to remove the shading from all your documents, with just a minor change:

Code:

Sub RemoveShading(oDoc)
Dim oStory As Range
    For Each oStory In oDoc.StoryRanges
        oStory.Font.Shading.BackgroundPatternColor = wdColorAutomatic
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                oStory.Font.Shading.BackgroundPatternColor = wdColorAutomatic
            Wend
        End If
    Next oStory
lbl_Exit:
    Set oStory = Nothing
    Exit Sub
End Sub

If you just want to identify the colours used, investigate the ColorCop utility which will identify any selected colour.

Tony · #3 04-07-2021, 11:28 PM

Thank you for your reply.

Removing colored shaded regions is of no interest to me.

My aim is to associate comments/notes which are unique to each shaded region. That is why I want to, as I wrote, "determine the range" for each shaded region. Having that range will allow me to associate the text with the notes/comments. For each document, I have the comments separately in sequential list.

Is there a way in vba to find the range start and end points for each shaded text?

macropod · #4 04-08-2021, 03:58 PM

Quote:

Originally Posted by Tony

My aim is to associate comments/notes which are unique to each shaded region.

If you're using Word's Comment tool, one can easily retrieve the range with which each comment is associated, in which case your shading is irrelevant. See, for example:
Export Comments with referred text and line numbers from Word to Excel | MrExcel Message Board

Still, if you want to get the shading ranges and their RGB colours:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long, Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Execute Replace:=wdReplaceAll
    .Wrap = wdFindStop
    .Font.Shading.BackgroundPatternColor = wdColorAutomatic
  End With
  Do While .Find.Execute
    i = .Start: Set Rng = ActiveDocument.Range(j, .Start)
    With Rng.Font.Shading
      Select Case .BackgroundPatternColor
        Case wdColorAutomatic
        Case wdColorWhite
        Case 9999999
          With Rng.Duplicate
            .Collapse wdCollapseStart
            Do While .End < Rng.End - 1
              If .Characters.Last.Next.Font.Shading.BackgroundPatternColor = _
                .Characters.First.Font.Shading.BackgroundPatternColor Then
                .End = .End + 1
              Else
                Select Case .Font.Shading.BackgroundPatternColor
                  Case wdColorAutomatic
                  Case wdColorWhite: .Collapse wdCollapseEnd
                  Case Else
                    MsgBox "Range: " & .Start & "-" & .End & vbCr & _
                      "Text: " & Chr(34) & .Text & Chr(34) & vbCr & _
                      "RGB: " & GetRGB(.Font.Shading.BackgroundPatternColor)
                    .Collapse wdCollapseEnd
                End Select
              End If
            Loop
          End With
        Case Else: MsgBox "Range: " & Rng.Start & "-" & Rng.End & vbCr & _
          "Text: " & Chr(34) & Rng.Text & Chr(34) & vbCr & _
          "RGB: " & GetRGB(.BackgroundPatternColor)
      End Select
    End With
    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
    .Collapse wdCollapseEnd
    If (ActiveDocument.Range.End - .End) < 2 Then Exit Do
    j = .End
  Loop
End With
Application.ScreenUpdating = True
End Sub

Function GetRGB(RGBvalue As Long) As String
Dim StrTmp As String
If RGBvalue < 0 Or RGBvalue > 16777215 Then RGBvalue = 0
StrTmp = StrTmp & " R: " & RGBvalue \ 256 ^ 0 Mod 256
StrTmp = StrTmp & " G: " & RGBvalue \ 256 ^ 1 Mod 256
StrTmp = StrTmp & " B: " & RGBvalue \ 256 ^ 2 Mod 256
GetRGB = StrTmp
End Function

Guessed · #5 04-08-2021, 12:01 AM

Tony

Background shading can always be tricky because the shading colour you see might be background or foreground or a mixture of the two. If your style inspector is saying the pattern is solid 100% then I would expect the colour you see is foreground since the background colour is obscured by 100% foreground.

Recording a find is always odd with where it puts the With statement so you can streamline that in your code

Code:

Set wR = wDoc.Content
Set wF = wR.Find
With wF
  .ClearFormatting
  .Font.Shading.BackgroundPatternColor = wdColorAutomatic
  .Text = ""
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindStop
  .Format = True
  Do While .Execute = True
    ...[lots of code]...
  Loop
End With

Tony · #6 04-08-2021, 12:07 AM

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?") As I said, my code doesn't work well (I could give details but not sure it's helpful to dwell on what doesn't work...)

If you could provide code that achieves this for a simple example, I'd be grateful.

Thanks

macropod · #7 04-08-2021, 12:54 AM

Quote:

Originally Posted by Tony

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
    .Collapse wdCollapseEnd
    If (ActiveDocument.Range.End - .End) < 2 Then Exit Do
  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.

Guessed · #8 04-08-2021, 12:47 AM

You didn't provide a document so I can't tell you what works for your document. You can record adding shading to text so you know what the code should be looking for. Then you can use that in your macro. Note that colours specified from the theme palette are NOT the same as an RGB colour specification.

This code works for me and includes two options that match my test doc depending on whether I specified the colour as RGB or via the palette

Code:

Sub FindShade()
  Dim wR As Range, wF As Find
  Set wR = ActiveDocument.Content
  Set wF = wR.Find
  With wF
    .ClearFormatting
    .Font.Shading.Texture = wdTextureNone
    '.Font.Shading.BackgroundPatternColor = -738132122   'this is a theme colour tint
    .Font.Shading.BackgroundPatternColor = 15652541     'this is a RGB colour that matches the theme colour
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    Do While .Execute = True
      wR.Select
      wR.Font.Bold = True
    Loop
  End With
End Sub

Tony · #9 04-08-2021, 01:28 AM

With this post I'm providing a test.docx as suggested by Guessed.

Using this file, I tried the code provided by both Guessed and macropod but neither worked. This could be because I'm doing something wrong like not supplying the color correctly.

I ran the code I wrote on this test.docx and this screenshot: test.png - Google Drive shows the result.

You'll notice that this is in Excel. My code is excel VBA that opens the Word document and manipulates it, extracting the range start, end point, the shaded text, and wdColor enumeration number for the shading color. The cell interior is also colored using this number.

This test.docx is very small, and it's easy to figure out the colors. but I don't know the colors for the many documents I have.

macropod · #10 04-08-2021, 06:33 AM

Quote:

Originally Posted by Tony

This test.docx is very small, and it's easy to figure out the colors. but I don't know the colors for the many documents I have.

One of the complications with your document is that some of it has automatic background shading - which is the default - and some has white background shading - which is visually indistinguishable from automatic background shading. Evidently, someone has shaded parts of the document in various colors, then tried to remove that by applying the white shading instead of reverting to 'no color'.

Tony · #11 04-08-2021, 06:59 AM

Believe me, I'm aware of this. I've been staring at this for many days. I agree it's complicated. That's why I need help. Thanks.

Guessed · #12 04-08-2021, 03:38 PM

I'm on a corporate network that blocks google drive so I can't see your file.

I'm assuming you want to get a list of the shadings applied throughout the document. The following shows how I would identify the shadings which exist in the document. It is unlikely to be fast in large documents. It will most likely return undefined if shading varies within a Word but it is going to be faster than stepping through characters.

If this is what you are trying to get to, you should eliminate the duplicates before using the other code you already have.

Code:

Sub FindAllShades()
  Dim aWord As Range, lPatt As Long, sList As String
  For Each aWord In ActiveDocument.Words
    If lPatt <> aWord.Font.Shading.BackgroundPatternColor Then
      lPatt = aWord.Font.Shading.BackgroundPatternColor
      sList = sList & lPatt & "|"
    End If
  Next aWord
  Debug.Print sList
  'use split to break this up into an array for stepping through the possibilities
End Sub

macropod · #13 04-08-2021, 04:04 PM

Quote:

Originally Posted by Guessed

I'm assuming you want to get a list of the shadings applied throughout the document. The following shows how I would identify the shadings which exist in the document. It is unlikely to be fast in large documents. It will most likely return undefined if shading varies within a Word but it is going to be faster than stepping through characters.

Unfortunately, the OP's document frequently has shading that changes in a Word, in which case the shading will be returned as 9999999.

Tony · #14 04-08-2021, 05:03 PM

Quote:

Originally Posted by Guessed

I'm on a corporate network that blocks google drive so I can't see your file.

Because of the problem mentioned by Guessed, I've now uploaded a new test.docx as an attachment -- If there is a better way, please let me know.

Tony · #15 04-08-2021, 05:41 PM

Thank you, macropod, for your code. I tried it on the test.docx I provided and it seems to work for the first line.

But then it seems to get stuck in this loop when it hits a particular wdColorAutomatic

Code:

Do While .End < Rng.End - 1
              If .Characters.Last.Next.Font.Shading.BackgroundPatternColor = _
                .Characters.First.Font.Shading.BackgroundPatternColor Then
                .End = .End + 1
              Else
                Select Case .Font.Shading.BackgroundPatternColor
                  Case wdColorAutomatic
                  Case wdColorWhite: .Collapse wdCollapseEnd
                  Case Else
...
                End Select

...

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Show field shading in Content Control	ajanson	Word	3	08-15-2016 04:49 PM
Clicking the selected Content Control checkbox returns wrong control in vba event	DougsGraphics	Word VBA	2	06-24-2015 07:31 AM
Question: How to maintain gray shading in text control box	tluken	Word	1	08-23-2012 10:20 AM
Shading, but only when printed	WilltheGrill09	Word	1	03-27-2012 02:44 AM
Equations shading	b0x4it	Word	4	05-18-2011 07:54 PM