Thursday, September 8, 2011

True title case

Word has the ability to set a block of text in title case, i.e. each of the words formatted so that its first letter is capitalized, thus:
A Tale Of Two Cities but formatting styles often dictate that articles, prepositions, and conjunctions should be in lower case, thus: A Tale of Two Cities.
Word has no built-in function to perform this type of formatting, but it can be achieved with a macro. The following sets the selected text in Word's title case and then sets all the words in the first array:
vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _
"If", "In", "Of", "On", "Or", "The", "To", "With")
to their lower case equivalents with a corresponding array
vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _
"if", "in", "of", "on", "or", "the", "to", "with")
The list of corrections can be expanded as required by simply adding the word in its alternative forms to both lists.
If one of the listed words was the first word in the selected text, then it too would be set in lower case, so that too needs to be corrected, and similarly if there is a colon in the selected text, the word following the colon would need to be corrected. The macro forces capitalization on the first letters of all words that appear in either position.
Sub TrueTitleCase()
Dim sText As Range
Dim vFindText As Variant
Dim vReplText As Variant
Dim i As Long
Dim k As Long
Dim m As Long
Set sText = Selection.Range
'count the characters in the selected string
k = Len(sText)
If k < 1 Then 'If none, then no string is selected
'so warn the user
     MsgBox "Select the text first!", vbOKOnly, "No text selected"
     Exit Sub 'and quit the macro
End If
'format the selected string as title case
sText.Case = wdTitleWord
'list the exceptions to look for in an array
vFindText = Array("A", "An", "And", "As", "At", "But", "By", "For", _
"If", "In", "Of", "On", "Or", "The", "To", "With")
'list their replacements in a matching array
vReplText = Array("a", "an", "and", "as", "at", "but", "by", "for", _
"if", "in", "of", "on", "or", "the", "to", "with")
With sText
     With .Find
     'replace items in the first list
     'with the corresponding items from the second

          .ClearFormatting
          .Replacement.ClearFormatting
          .Forward = True
          .Wrap = wdFindStop
          .MatchWholeWord = True
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .Format = True
          .MatchCase = True
          For i = LBound(vFindText) To UBound(vFindText)
               .Text = vFindText(i)
               .Replacement.Text = vReplText(i)
               .Execute Replace:=wdReplaceAll
          Next i
     End With
     'Reduce the range of the selected text
     'to encompass only the first character

     .MoveEnd Unit:=wdCharacter, Count:=-Len(sText) + 1
     'format that character as upper case
     .Case = wdUpperCase
     'restore the selected text to its original length
     .MoveEnd Unit:=wdCharacter, Count:=k
     'and check to see if the string contains a colon
     If InStr(1, sText, ":") > 0 Then
     'If it does note the position of the character
     'after the first colon

          m = InStr(1, sText, ":") + 1
          'and set that as the new start of the selected text
          .MoveStart wdCharacter, m
          'set the end of the selected text to include
          'one extra character

          .MoveEnd Unit:=wdCharacter, Count:=-Len(sText) + 1
          'format that character as upper case
          .Case = wdUpperCase
     End If
End With
End Sub

No comments:

Post a Comment