#1
|
|||
|
|||
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 |
#2
|
||||
|
||||
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 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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
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? |
#4
|
||||
|
||||
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 |
#5
|
|||
|
|||
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 |
#6
|
||||
|
||||
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 |
#7
|
||||
|
||||
Quote:
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
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. Last edited by Tony; 04-08-2021 at 05:04 PM. Reason: added link to screenshot |
#9
|
||||
|
||||
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] |
#10
|
|||
|
|||
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.
|
#11
|
||||
|
||||
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 |
#12
|
||||
|
||||
Quote:
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] |
#13
|
||||
|
||||
Quote:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#14
|
|||
|
|||
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.
|
#15
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
|
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 |