Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-07-2021, 10:27 PM
Tony Tony is offline vba control of shading Windows 10 vba control of shading Office 2019
Novice
vba control of shading
 
Join Date: Apr 2021
Posts: 12
Tony is on a distinguished road
Default vba control of shading

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


Last edited by Tony; 04-07-2021 at 11:28 PM. Reason: added link to screenshot
Reply With Quote
  #2  
Old 04-07-2021, 11:14 PM
gmayor's Avatar
gmayor gmayor is offline vba control of shading Windows 10 vba control of shading Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 04-07-2021, 11:28 PM
Tony Tony is offline vba control of shading Windows 10 vba control of shading Office 2019
Novice
vba control of shading
 
Join Date: Apr 2021
Posts: 12
Tony is on a distinguished road
Default aim

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?
Reply With Quote
  #4  
Old 04-08-2021, 12:01 AM
Guessed's Avatar
Guessed Guessed is offline vba control of shading Windows 10 vba control of shading Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
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

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
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #5  
Old 04-08-2021, 12:07 AM
Tony Tony is offline vba control of shading Windows 10 vba control of shading Office 2019
Novice
vba control of shading
 
Join Date: Apr 2021
Posts: 12
Tony is on a distinguished road
Default

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
Reply With Quote
  #6  
Old 04-08-2021, 12:47 AM
Guessed's Avatar
Guessed Guessed is offline vba control of shading Windows 10 vba control of shading Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
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

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
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #7  
Old 04-08-2021, 12:54 AM
macropod's Avatar
macropod macropod is offline vba control of shading Windows 10 vba control of shading Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
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

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
  #8  
Old 04-08-2021, 01:28 AM
Tony Tony is offline vba control of shading Windows 10 vba control of shading Office 2019
Novice
vba control of shading
 
Join Date: Apr 2021
Posts: 12
Tony is on a distinguished road
Default test.docx

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.
Attached Files
File Type: docx test.docx (18.2 KB, 12 views)

Last edited by Tony; 04-08-2021 at 05:04 PM. Reason: added link to screenshot
Reply With Quote
  #9  
Old 04-08-2021, 06:33 AM
macropod's Avatar
macropod macropod is offline vba control of shading Windows 10 vba control of shading Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
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

Quote:
Originally Posted by Tony View Post
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'.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #10  
Old 04-08-2021, 06:59 AM
Tony Tony is offline vba control of shading Windows 10 vba control of shading Office 2019
Novice
vba control of shading
 
Join Date: Apr 2021
Posts: 12
Tony is on a distinguished road
Default

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.
Reply With Quote
  #11  
Old 04-08-2021, 03:38 PM
Guessed's Avatar
Guessed Guessed is offline vba control of shading Windows 10 vba control of shading Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
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

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
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #12  
Old 04-08-2021, 03:58 PM
macropod's Avatar
macropod macropod is offline vba control of shading Windows 10 vba control of shading Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
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

Quote:
Originally Posted by Tony View Post
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
    If .End = ActiveDocument.Range.End Then Exit Do
    .Collapse wdCollapseEnd
    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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #13  
Old 04-08-2021, 04:04 PM
macropod's Avatar
macropod macropod is offline vba control of shading Windows 10 vba control of shading Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
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

Quote:
Originally Posted by Guessed View Post
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.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #14  
Old 04-08-2021, 05:03 PM
Tony Tony is offline vba control of shading Windows 10 vba control of shading Office 2019
Novice
vba control of shading
 
Join Date: Apr 2021
Posts: 12
Tony is on a distinguished road
Default

Quote:
Originally Posted by Guessed View Post
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.
Reply With Quote
  #15  
Old 04-08-2021, 05:40 PM
Guessed's Avatar
Guessed Guessed is offline vba control of shading Windows 10 vba control of shading Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,932
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

I thought that might be the case. It probably doesn't matter so much as long as there is at least one full Word (and trailing space) on either side of that undefined shading to capture both values that can then be used by the Find code. This modification excludes undefined and duplicate values
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
      If Not sList Like "*" & lPatt & "*" And lPatt <> 9999999 Then
        sList = sList & lPatt & "|"
      End If
    End If
  Next aWord
  Debug.Print sList
End Sub
I'm not exactly sure what the OP is trying to do with the 'associate comments/notes' but I would expect that iterating through the comments (as you suggested) would be a more logical thing to do than trying to work through the shading changes.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
Reply

Thread Tools
Display Modes


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

Other Forums: Access Forums

All times are GMT -7. The time now is 12:41 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft