![]() |
#1
|
|||
|
|||
![]()
Not much activity here any more, so I thought I would try to spark some interest/get comments on some code that I was tinkering with the other day.
There is a post in the Microsoft forums where the users wants (or at least seems to want) a process to find and select each instance of text with the font formatted various different colors e.g., the old standard red (255) and the new standard red (238). As the segments of formatted text might be mixed throughout the document e.g., XXX 255 XXX XXX 238 XXX XXX 255 etc., ideally it would be selected and evaluated serially through the document (not in two separate loops). Redirecting I posted something in reply that worked but it was a bit clunky and I didn't get a reply. This morning I decided to improve that process by using a Collection to gather the range start and end points then sort and loop through that collection: Code:
Sub EvaluateTextByFontColor() Dim oCol As New Collection Dim oRng As Range Dim lngIndex As Long Dim varParts As Variant Dim arrColors() As String arrColors = Split("238|255|49407", "|") For lngIndex = 0 To UBound(arrColors) Set oRng = ActiveDocument.Range 'Find all instances of text formated RGB 238, 255 and 49407 With oRng.Find .Font.TextColor.RGB = arrColors(lngIndex) While .Execute oCol.Add oRng.Start & "|" & oRng.End oRng.Collapse wdCollapseEnd Wend End With Next lngIndex fcnSortColumn oCol 'Loop through collection of ranges to evaluate. For lngIndex = 1 To oCol.Count varParts = Split(oCol(lngIndex), "|") ActiveDocument.Range(varParts(0), varParts(1)).Select If MsgBox("Convert to black?", vbQuestion + vbYesNo, "CONVERT") = vbYes Then Selection.Font.TextColor = wdColorBlack End If Next lngIndex lbl_Exit: Exit Sub End Sub Public Function fcnSortColumn(ByVal oColPassed As Collection) As Collection Dim lngA As Long, lngB As Long Dim vOld As Variant Dim varP1 As Variant, varP2 As Variant For lngA = 1 To oColPassed.Count - 1 varP1 = Split(oColPassed(lngA), "|")(0) For lngB = lngA + 1 To oColPassed.Count varP2 = Split(oColPassed(lngB), "|")(0) If varP1 > varP2 Then vOld = oColPassed(lngB) oColPassed.Remove lngB oColPassed.Add vOld, vOld, lngA End If Next lngB Next lngA Set fcnSortColumn = oColPassed lbl_Exit: Exit Function End Function Last edited by gmaxey; 06-17-2025 at 05:49 AM. |
#2
|
||||
|
||||
![]()
The code looks as compact as you could possibly make it but there could be improvements made.
First, the MsgBox question will recolour the entire document range if you ever choose yes because oRng wasn't redefined to limit itself to just the selection. You probably meant to use the selection {or ActiveDocument.Range(varParts(0), varParts(1))} instead of oRng in this line oRng.Font.TextColor = wdColorBlack
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
![]()
Andrew,
Thanks. You are correct of course. Last minute changes without testing can always bite. I just changed oRng to Selection in the above code. |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Feedback suggestions not using default browser | MC147 | Office | 0 | 01-28-2023 06:21 AM |
Form Letter Help/Suggestions | Sociopsychosis | Word | 2 | 10-18-2016 05:52 AM |
![]() |
FedSteve | Word | 1 | 09-01-2016 11:23 PM |
![]() |
JeffL | Word | 4 | 12-28-2013 01:12 PM |
![]() |
veed | Drawing and Graphics | 3 | 04-19-2013 08:36 AM |