MACROS IN MS WORD
Here are my two handouts on macro basics. They are also mounted on the most fascinating website of Ken Kronenberg.
(These handouts are a couple of years old and I have not checked the links. Most of them I know are still active. If you have trouble finding one, do a search for it by name in Google, in case the owner has changed host or some such thing.)
PROOFING MACRO -- click here to go directly to progress notes on the improvement of this macro.
OK, folks, told you you'd be sorry. Here's my monster proofreading macro. It's not very elegant, but it's worked perfectly for many years. It was created to find formatting and mechanical punctuation errors in documents intended for publication in academic journals, so it searches for those little oddities that computers delight in spawning--double periods, two spaces where there ought to be one, a space between a parenthesis and the letter that follows it, etc. The kind of stuff that comes up with a lot of cutting and pasting, on-screen editing, and change-tracking, and that are very hard to see. It can easily be modified--I made a version to find specific punctuation issues for a law office, for example. You could check for questionable words, too, as Judith wants to do.
In some of the searches, there's no need for human intervention. The macro finds double spaces and reduces them to one automatically. It automatically removes spaces from before or after paragraph markers and tabs. Things like that. The computer is much less likely to miss such tiny errors than a person proofreading on screen.
The second and larger group of searches does need human checking, like Judith's homophones. Usually you don't want a period followed by a comma, for instance, but in some cases after an ellipsis that is how it works out. The macro marks any suspicious findings with @, which is very easy to see and not likely to be used in any other context. Once the anomalies are marked for review they can be quickly found and corrected. Then I can settle down to what I think of as real proofreading, which requires thought and judgment--like whether that sentence would be better with commas or dashes. It's easier for me to relax about that when I know the mechanical stuff is taken care of.
Notes:
1) Some of these contingencies won't make much sense, they're only relevant to formatting the journal bibliographies.
2) Protect ellipses--I protect the ellipses by reformatting them temporarily so they are not wrecked by the search for multiple periods or periods preceded by a space. They are restored at the end.
3) G&M is a law firm for which I make macros when necessary.
4) Some of these subroutines are independent macros that I keep separate so as to be able to use them by themselves. The proofing macro calls and runs them when necessary.
I've also appended the review macro that goes with this one. It's on a keyboard shortcut command so that it can hunt through the file, moving from one @ to the next. It lands at the beginning of each one. I check the place out, fix it if necessary, remove the marker with one click of ^G (my keyboard delete shortcut--thank you, WordStar!), and then another click calls the macro again and moves it on to the next place.
As Phil would say, I hope this helps!
PROOFING MACRO
Sub ProofingNew()
'
' ProofingNew Macro
' Macro created 11/05/02 by Eve Golden
'
' Proofing Macro
' EG 07/15/99.
'
' Compact Proofing Macro. Flags possible errors with red @.
' FIRST, PROTECTS THE ELLIPSES.
' Protect Ellipses calls a macro by that name (in Normal.dot).
ProtectEllipses
' GETS RID OF DOUBLE SPACES.
For x = 1 To 6
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next x
' REMOVES LEADING AND TRAILING SPACES FROM P-MARKERS.
' (In Normal.dot.)
PFromPSpace
PFromPSpace
PFromSpaceP
PFromSpaceP
' REMOVES LEADING AND TRAILING SPACES FROM TABS.
' TabsNoSpaces calls a macro of that name. (In Normal.dot.)
TabsNoSpaces
' REMOVES LEADING AND TRAILING SPACES FROM HYPHENS.
With Selection.Find
.Text = " -"
.Replacement.Text = "-"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "- "
.Replacement.Text = "-"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
' The following subs do not change anything automatically.
' They MARK suspicious combinations of punctuation --
' occurrences that are usually wrong, but in certain
' circumstances may be correct. These
' will be marked with a red @ sign, allowing a person to spot
' them easily and decide what to do about them in each
' individual case.
'SPACES BEFORE PERIODS.
'OK now because of the ellipsis protection routine
'THAT MUST RUN AT THE START
'of the macro.
'But it should run as is for G&M.
With Selection.Find
.Text = " ."
.Replacement.Text = "@ ."
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SPACES BEFORE QUESTION MARKS.
With Selection.Find
.Text = " ?"
.Replacement.Text = "@ ?"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SPACES BEFORE SEMICOLONS.
With Selection.Find
.Text = " ;"
.Replacement.Text = "@ ;"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SPACES BEFORE COLONS.
With Selection.Find
.Text = " :"
.Replacement.Text = "@ :"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SPACES BEFORE COMMAS.
With Selection.Find
.Text = " ,"
.Replacement.Text = "@ ,"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'DOUBLE PERIODS.
'Again, this is OK because the Ellipsis protection is run first.
' For G&M it should run.
With Selection.Find
.Text = ".."
.Replacement.Text = "@.."
.Forward = True
.Wrap = wdFindContinue
End With
' Selection.Find.Execute Replace:=wdReplaceAll
'DOUBLE COMMAS.
With Selection.Find
.Text = ",,"
.Replacement.Text = "@,,"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'DOUBLE COLONS.
With Selection.Find
.Text = "::"
.Replacement.Text = "@::"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'DOUBLE SEMICOLONS.
With Selection.Find
.Text = ";;"
.Replacement.Text = "@;;"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'PERIOD COMMA
With Selection.Find
.Text = ".,"
.Replacement.Text = "@.,"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'PERIOD COLON.
With Selection.Find
.Text = ".:"
.Replacement.Text = "@.:"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
'PERIOD SEMICOLON.
With Selection.Find
.Text = ".;"
.Replacement.Text = "@.;"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'COMMA PERIOD.
With Selection.Find
.Text = ",."
.Replacement.Text = "@,."
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'COMMA COLON.
With Selection.Find
.Text = ",:"
.Replacement.Text = "@,:"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'COMMA SEMICOLON.
With Selection.Find
.Text = ",;"
.Replacement.Text = "@,;"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SEMICOLON PERIOD.
With Selection.Find
.Text = ";."
.Replacement.Text = "@;."
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
'SEMICOLON COMMA.
With Selection.Find
.Text = ";,"
.Replacement.Text = "@;,"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SEMICOLON COLON.
With Selection.Find
.Text = ";:"
.Replacement.Text = "@;:"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'COLON PERIOD.
With Selection.Find
.Text = ":."
.Replacement.Text = "@:."
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'COLON COMMA.
With Selection.Find
.Text = ":,"
.Replacement.Text = "@:,"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'COLON SEMICOLON.
With Selection.Find
.Text = ":;"
.Replacement.Text = "@:;"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SPACE APOSTROPHE SPACE.
With Selection.Find
.Text = " ' "
.Replacement.Text = "@ ' "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SPACE QUOTATION MARK SPACE.
With Selection.Find
.Text = " "" "
.Replacement.Text = "@ "" "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'PARENTHESIS SPACE QUOTATION MARK.
With Selection.Find
.Text = ") """
.Replacement.Text = "@) "" "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'PARENTHESIS QUOTATION MARK.
With Selection.Find
.Text = ")"""
.Replacement.Text = "@)"" "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'QUOTATION MARK PARENTHESIS PERIOD.
With Selection.Find
.Text = ")."""
.Replacement.Text = "@)."" "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'PERIOD PARENTHESIS.
With Selection.Find
.Text = ".)"
.Replacement.Text = "@.) "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'PERIOD BRACKET.
With Selection.Find
.Text = ".]"
.Replacement.Text = "@.] "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'PARENTHESIS PERIOD.
' With Selection.Find
' .Text = ")."
' .Replacement.Text = "@). "
' .Forward = True
' .Wrap = wdFindContinue
' End With
' Selection.Find.Execute Replace:=wdReplaceAll
'BRACKET PERIOD.
' With Selection.Find
' .Text = "]."
' .Replacement.Text = "@]."
' .Forward = True
' .Wrap = wdFindContinue
' End With
' Selection.Find.Execute Replace:=wdReplaceAll
'PERIOD PARENTHESIS 2.
With Selection.Find
.Text = ".("
.Replacement.Text = "@.("
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'PERIOD BRACKET 2.
With Selection.Find
.Text = ".["
.Replacement.Text = "@.["
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'QUOTATION MARK PERIOD.
With Selection.Find
.Text = """."
.Replacement.Text = "@"". "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'QUOTATION MARK COMMA.
With Selection.Find
.Text = ""","
.Replacement.Text = "@"", "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'APOSTROPHE PERIOD.
With Selection.Find
.Text = "'."
.Replacement.Text = "@'. "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'APOSTROPHE COMMA.
With Selection.Find
.Text = "',"
.Replacement.Text = "@', "
.Forward = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
'QUESTION MARK QUOTATION MARK.
With Selection.Find
.Text = "?"""
.Replacement.Text = "@?"" "
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'QUOTATION MARK QUESTION MARK.
With Selection.Find
.Text = """?"
.Replacement.Text = "@""?"
.Forward = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
'COMMA SPACE 1.
'Searches for commas incorrectly separating names and
'dates in in-text citations. However, it will also find
'correct uses in dates and bibliographies.
With Selection.Find
.Text = ", 1"
.Replacement.Text = "@, 1"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'COMMA SPACE pp SPACE.
With Selection.Find
.Text = ", pp "
.Replacement.Text = "@, pp "
.Forward = True
.MatchCase = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'COMMA SPACE p SPACE.
With Selection.Find
.Text = ", p "
.Replacement.Text = "@, p "
.Forward = True
.MatchCase = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SPACE P.
With Selection.Find
.Text = " P "
.Replacement.Text = "@ P "
.Forward = True
.MatchCase = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SPACE Pp.
With Selection.Find
.Text = " Pp"
.Replacement.Text = "@ Pp"
.Forward = True
.MatchCase = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'SPACE PP.
With Selection.Find
.Text = " PP"
.Replacement.Text = "@ PP"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
' EMPTY OUT PARENS AND BRACKETS.
' Removes extraneous spaces from within parens and brackets.
' EG 7/13/99.
'
With Selection.Find
.Text = "( "
.Replacement.Text = "("
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "[ "
.Replacement.Text = "["
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " )"
.Replacement.Text = ")"
.Forward = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " ]"
.Replacement.Text = "]"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'TRANS.
With Selection.Find
.Text = "trans."
.Replacement.Text = "@trans."
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
'EDS.
With Selection.Find
.Text = "eds."
.Replacement.Text = "@eds."
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
' RESTORE ELLIPSES BACK TO DOTTED MODE (in Normal.dot.)
RestoreEllipses
'TURN ALL THE @ MARKERS RED.
With Selection.Find.Replacement.Font
.Bold = True
.ColorIndex = wdRed
End With
With Selection.Find
.Text = "@"
.Replacement.Text = "@"
.Forward = True
.Wrap = wdFindContinue
.Format = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Response = MsgBox("Now look for the red @ signs and check for possible errors.",
vbExclamation)
MARKER FIND MACRO:
Sub MarkerFind()
'
' MarkerFind Macro
' Finds the marker (@) that flags suspect punctuation and formatting of citations. Macro recorded 07/13/99 by
EG
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "@"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
End Sub
SUPPORTING MACROS
Here are the supporting macros. You will see that the Protect Ellipses macro takes into account a bunch of different formattings of the three- and four-dot ellipses, because different authors type them in different ways. I wanted the macro to find all the possible variants. But the Restore Ellipses macro is shorter, because I restored them only to the official form that the journal uses.
PROTECT ELLIPSES
Sub ProtectEllipses()
'
' ProtectEllipses Macro
' Sequesters both 3- and 4-dot ellipses with [[[3-dot]]] or [[[4-dot]]],
' to keep them from being changed in proofing. Run BEFORE proofing.
' After proofing, run EllipsisRestore to fix them back up again. EG 8/03/99.
' Look for the 4-dots first. Otherwise the last dot gets lost.
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "...."
.Replacement.Text = "[[[4-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ". . . . "
.Replacement.Text = "[[[4-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ". . . ."
.Replacement.Text = "[[[4-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " . . . "
.Replacement.Text = "[[[3-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ". . . "
.Replacement.Text = "[[[3-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " . . ."
.Replacement.Text = "[[[3-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ". . ."
.Replacement.Text = "[[[3-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "... "
.Replacement.Text = "[[[3-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " ... "
.Replacement.Text = "[[[3-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " ..."
.Replacement.Text = "[[[3-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "..."
.Replacement.Text = "[[[3-dot]]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
End Sub
PFromPSpace
Sub PFromPSpace()
'
' PFromPSpace Macro
' Removes spaces from after p-markers (the ones that end up lying at the
beginnings of new lines. EG July 15, 1999
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p "
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
End Sub
PFromSpaceP
Sub PFromSpaceP()
'
' PFromSpaceP Macro
' Removes spaces from in front of P-markers. EG July 15 1999.
Selection.HomeKey Unit:=wdStory
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
End Sub
TabsNoSpaces
Sub TabsNoSpaces()
'
' TabsNoSpaces Macro
' Removes spaces from around tabs. Macro recorded 07/14/99 by Eve Golden, M.D.
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " ^t"
.Replacement.Text = "^t"
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^t "
.Replacement.Text = "^t"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
End Sub
Restore Ellipses
Sub RestoreEllipses()
'
' RestoreEllipses Macro
' Restores ellipses to their correct mode after proofing. Also expands the
condensed ones. EG 8/03/99.
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "[[[3-dot]]]"
.Replacement.Text = " . . . "
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "[[[4-dot]]]"
.Replacement.Text = ". . . . "
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
End Sub
Fellow DailyWordTips lister David Grugeon has made some elegant improvements to this rough-and-ready macro. Anyone interested should read this page for background, and then go to his page ( http://www.grugeon.com.au/ProofingMacro.html ) and download his version.
And Klaus Doehler has contributed a much better subroutine for reducing multiple spaces to one. Here it is.
Klaus Doehler's Space-Reducing Macro
Sub ReduceMoreThanOneSpacesToOne()
With Selection.Find
.Text = " {2,}"
.Replacement.Text = " "
.Wrap = wdFindStop
.MatchWildcards = True
.Execute Replace=wdReplaceAll
End With
End Sub