#1
|
|||
|
|||
Macro to replace text and track changes based on user-defined rules
Dear all,
I am completely new to VBA, but I use Word to edit large technical documents daily using Track Changes. The aim is partly to produce a consistent style among the documents. As a result, I end up making similar changes to multiple documents daily. To improve my productivity, I would like to be able to define rules, for example "for the whole word CO2, subscript the 2" and have a macro apply those changes to the documents I'm working on. In my workflow, I would run this macro first, before making any other changes. I would need the changes to be tracked as if I had made them manually. I would need to be able to create, save, and reload multiple rule sets, each containing a large number of rules, and some of the rules within each set would be quite complex. An example of a more complex rule is "when there are two words in italics, and the first of those words is capitalized (Example here), for subsequent instances of the same two words (but not for the first instance in the document), shorten the first word to the initial letter (E. here)". I'm looking for advice. My questions are: 1. Is there an existing program, add-in, or macro that can perform these types of operations? 2. If not, would it be very difficult to design such a macro? Apologies if this is a question that has been asked before. I was unable to find anything similar on Google or using the forum search function. Any help is much appreciated. Best wishes, Chris |
#2
|
|||
|
|||
1. Yes. There are undoubtedly hundreds of macros scattered about which are designed to perform these types of operations. Whether anyone as combined those into a ready made tool (add-in) to meet your exact requirements is unlikely.
2. Designing the macro would be a matter (degree of difficulty depends on the designer's skill level) of creating the individual parts. Here is a start: Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey Dim oRng As Word.Range Dim lngIndex As Long ActiveDocument.TrackRevisions = True Set oRng = ActiveDocument.Range With oRng.Find .Text = "CO2" .MatchWholeWord = True While .Execute If Not oRng.Characters(2).Font.Superscript = True Then oRng.Characters(2).Font.Superscript = True End If oRng.Collapse wdCollapseEnd Wend Set oRng = ActiveDocument.Range lngIndex = 0 With oRng.Find .Text = "<*> <*>" .Font.Italic = True .MatchWildcards = True While .Execute lngIndex = lngIndex + 1 If Not lngIndex = 1 Then oRng.Words(1) = oRng.Words(1).Characters(1) & ". " End If oRng.Collapse wdCollapseEnd Wend End With End With lbl_Exit: Exit Sub End Sub |
#3
|
||||
|
||||
FWIW, I wrote the following macro some years back - it will search the active document for all numbers preceded by a letter or a right bracket, and subscript just the numbers. Thus, C5H8(N2S)4 becomes C5H8(N2S)4, whilst 3(CaO)•2(SiO2)•4(H2O)(gel) + 3Ca(OH)2 becomes 3(CaO)•2(SiO2)•4(H2O)(gel) + 3Ca(OH)2. Unless you're working with isotopes, the results should be correct - you'll need to apply the isotope superscripting yourself (if the numbers are already superscripted, they’ll be left alone).
If your document has other alphanumeric strings in which a non-superscripted number follows a letter (eg Table cell references), you’ll need to select only the range(s) containing the text to be converted and answer ‘No’ to the prompt. Code:
Sub ChemPwrFmt() Application.ScreenUpdating = False Dim oRng As Range, fRng As Range, bState As Boolean Select Case MsgBox("Do you want to process the whole document?", _ vbYesNoCancel + vbQuestion, "Chemical/Power Formatter") Case vbYes bState = True Case vbNo bState = False Case vbCancel End End Select With Selection Set oRng = .Range With .Find .ClearFormatting .Text = "[A-Za-z)][0-9]{1,}" .MatchWildcards = True .Wrap = wdFindContinue .Forward = True Do While .Execute = True Set fRng = ActiveDocument.Range(Start:=Selection.Start + 1, End:=Selection.End) If bState = False Then If fRng.Start >= oRng.End Then Exit Do If fRng.End >= oRng.End Then fRng.End = oRng.End End If If fRng.Font.Superscript = False Then fRng.Font.Subscript = True fRng.Collapse Direction:=wdCollapseEnd Loop End With End With oRng.Select Set fRng = Nothing: Set oRng = Nothing Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
|||
|
|||
Dear Greg and Paul,
Thanks so much for your help. The pieces of code you posted are really useful and already make my working day a little easier. I will put some time aside to studying VBA and see if I can write some useful macros myself over time. Cheers, Chris |
#5
|
|||
|
|||
Another quick question...
I'm using the following snippet of code as an extension to what Greg wrote .Text = "[0-9]-[0-9]" .MatchWildcards = True .MatchWholeWord = False .Replacement.Text = "–" .Execute Replace:=wdReplaceAll, Forward:=True, _ Wrap:=wdFindContinue How can I amend this to only replace the 2nd character of the found text? I've tried putting ".Character(2)" in various places, and a few other ideas, but to no avail. Thanks. Also, instead of using "ActiveDocument.Range" is there a way to get the macro to ignore deleted text in Track Changes revisions? |
#6
|
||||
|
||||
What do you want to replace the second character with?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
I'm aiming to replace hyphens with an 'en dash' character ("–") in numerical ranges, e.g., "21-42" -> "21–42".
|
#8
|
||||
|
||||
In that case:
Code:
Sub Demo() Application.ScreenUpdating = False With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "([0-9])-([0-9])" .Replacement.Text = "\1^0150\2" .Forward = True .Wrap = wdFindContinue .Format = False .MatchWildcards = True .Execute Replace:=wdReplaceAll End With End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
Thanks Paul.
That works well with Track Changes off. However... with Track Changes on, that code converts 44-55 to 445–5. |
#10
|
||||
|
||||
For use with Track Changes, try:
Code:
Sub Demo() Application.ScreenUpdating = False With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "([0-9])-([0-9])" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True .Execute End With Do While .Find.Found = True .Characters(2).Text = Chr(150) .Collapse wdCollapseEnd .Find.Execute Loop End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#11
|
|||
|
|||
Works perfectly. Thanks so much!
I've been adapting your code to make various replacements and it does the job really well. I'm flying through the changes I need to code (except the complex stuff). The main "simple" thing I'm struggling with is finding and replacing Unicode characters. Specifically: 1. Replacing apostrophes after numbers with prime symbols, e.g. 3' -> 3′. 2. Replacing the string "space hyphen number" with the string "space minus sign number", e.g., -3 -> −3. 3. For percentage ranges written with 2 percentage signs and an en dash, delete the first percentage sign, e.g., 5%–30% -> 5–30%. I made this work for hyphens but not en dashes. I've tried things like ".Text = ChrW(###)", with both hexadecimal and decimal codes, but I haven't been able to make .Find latch on to Unicode characters at all so far... |
#12
|
|||
|
|||
For number 1:
Sub Test() Dim oRng As Range Set oRng = ActiveDocument.Range With oRng.Find .Text = "([0-9]{1,})(" & Chr(39) & ")" .MatchWildcards = True .Replacement.Text = "\1" & ChrW(8242) .Execute Replace:=wdReplaceAll End With lbl_Exit: Exit Sub End Sub We won't give you all of the fish since you seem willing to learn to fish ;-) |
#13
|
|||
|
|||
Thank you again!
Based on your helpful advice, I solved those 3 problems and a few more. My macro is now getting quite large (about 1700 lines and growing daily). I'm now stuck on a point concerning field codes... The current version of my macro contains the following code, thanks to the previous information in this thread: Quote:
I'm grateful for your expert help with all of these questions. I'm enjoying dabbling in coding and the experience has inspired me to sign up to an 'Intro to Computer Science' course. |
#14
|
|||
|
|||
Numbered Fish,
Something weird going on here (Paul help us out). I opened and new document and entered: 1-{Qoute "1"} When toggled the content looks like this: 1-1 I ran your macro and NOTHING happened! Like you seem to want to prevent, I thought would have occurred. Here is some code that illustrates the weird behavior that seems to be due to the "-" (dash) in the .Find string: Code:
Sub ScratchMacro() 'A basic Word macro coded by Greg Maxey 'For replacing hyphens in numerical ranges with an en dash Dim oRNg As Word.Range Set oRNg = ActiveDocument.Range With oRNg.Find .ClearFormatting .Replacement.ClearFormatting 'Note using 1-{Quote "1"} toggled to display 1-1 .Text = "[0-9]-[0-9]" 'Wasn't found .Text = "[0-9]" & Chr(45) & "[0-9]" 'Wasn't found .Text = "[0-9]-" 'Found 'Remove "-" between displayed numbers .Text = "[0-9][0-9]" 'Found 'Put dash back between numbers .Text = "[0-9]*[0-9]" 'Found .Forward = True .Wrap = wdFindStop .Format = False .MatchWildcards = True While .Execute If oRNg.Characters(2) = Chr(45) Then If oRNg.Fields.Count = 0 Then If oRNg.Characters(3).Font.Superscript = False Then oRNg.Characters(2).Text = Chr(150) oRNg.Collapse wdCollapseEnd oRNg.Find.Execute End If End If End If Wend End With lbl_Exit: Exit Sub End Sub Best Regards, Greg Maxey The problem with socialism is that you eventually run out of other peoples' money. ~Margaret Thatcher |
Tags |
editing, macro, tracked changes |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
FileSystemObject Compile Error: User-Defined Type Not Defined | gsrikanth | Excel Programming | 2 | 03-28-2022 06:32 AM |
User Defined Fields | daveybops | Outlook | 1 | 05-06-2014 10:25 AM |
Word VBA Macro to Find and Replace based on the Alt Text of an Image | bennymc | Word VBA | 1 | 01-27-2014 04:23 PM |
User-defined Type not Defined VBA Issue | OTPM | Project | 3 | 01-02-2014 01:47 PM |
Change standard highlight text color to user defined | Scott Duffens | Word | 2 | 06-18-2012 03:53 PM |