As a software developer, I get to contend with Technical Specifications
that often contain many hyphenated terms that are not words. I have
"Ignore words in UPPERCASE" checked on the Spelling and Grammar dialog
box, but not all the jargon words are in all uppercase. I created
these Macros to prompt me and optionally convert hyphenated words to
uppercase. I am not a Word VBA guru, so my solution may be a little
ham-fisted. As such, I invite suggestions to improve this.
Ken Grubb
Bellevue, WA, USA
Public Sub UppercaseHyphenatedWords()
Call GenericUppercase("<[a-zA-Z0-9]{1,}-[a-zA-Z0-9-]{1,}>")
End Sub
Public Sub UppercaseUnderscoredWords()
Call GenericUppercase("<[a-zA-Z0-9]{1,}_[a-zA-Z0-9_]{1,}>")
End Sub
Private Sub GenericUppercase(sInput As String)
Dim bContinue As Boolean
Dim bSkip As Boolean
Dim Response
Dim sArray() As String
Dim iArray As Integer
Dim i As Integer
iArray = 0
bContinue = True
Selection.HomeKey Unit:=wdStory
Do While bContinue
bSkip = False
With Selection.Find
.ClearFormatting
.Text = sInput
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
If Selection.Find.Execute Then
If Selection.Text = UCase$(Selection.Text) Then
' Skip hyphenated words already in UPPERCASE
Else
If iArray > 0 Then
For i = 1 To iArray
If sArray(i) = LCase$(Selection.Text) Then
' Skip words previously skipped
bSkip = True
End If
Next i
End If
If Not bSkip Then
Response = MsgBox("Change all occurrences of " &
LCase$(Selection.Text) & " to " & UCase$(Selection.Text) & "?",
vbYesNoCancel)
Select Case Response
Case vbYes
Call GlobalReplace(LCase$(Selection.Text),
UCase$(Selection.Text))
Case vbNo
' User skipped this word
iArray = iArray + 1
ReDim Preserve sArray(iArray)
sArray(iArray) = LCase$(Selection.Text)
Case vbCancel
MsgBox "Done!"
bContinue = False
End Select
End If
End If
Else
MsgBox "Done!"
bContinue = False
End If
Loop
End Sub
Private Sub GlobalReplace(sFromText As String, sToText As String)
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = sFromText
.Replacement.Text = sToText
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub