#1
|
|||
|
|||
How do I convert a line of text to title case?
I seem to remember in older versions of word that I could convert a text string to upper, lower, or title case. I don't seem to be able to do that now. |
#2
|
||||
|
||||
Word has no true 'Title' case conversion. It does have a 'Capitalize each word' option:
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
||||
|
||||
Word's TitleCase function is a fairly blunt instrument that crudely capitalises the first letter of each word and destroys the capitalisation for acronyms and various surnames, for example. Such an approach really doesn't conform to the usual understanding title casing.
The following function will apply a true title case to whatever string you feed into it. Note the comments as to what the optional parameters do. Code:
Function TitleCase(StrTxt As String, Optional bCaps As Boolean, Optional bClos As Boolean, Optional bExcl As Boolean) As String 'Convert an input string to proper-case. 'Surnames like O', Mc & Mac and hyphenated names are converted to title case also. 'If bCaps = True, then upper-case strings like ABC are preserved; otherwise they're converted. 'If bClos = False, words in the exclusion list after closing characters are retained as lower-case; otherwise they're converted. 'If bExcl = True, words in the exclusion list are retained as lower-case, unless after specified punctuation marks. Dim i As Long, j As Long, k As Long, l As Long, bFnd As Boolean Dim StrChr As String, StrExcl As String, StrMac As String, StrPunct As String, StrTmpA As String, StrTmpB As String 'General exclusion list. StrExcl = "(a),a,am,an,and,are,as,at,(b),be,but,by,(c),can,cm,(d),did,do,does,(e),eg,en,eq,etc,(f),for," & _ "(g),get,go,got,(h),has,have,he,her,him,how,(i),ie,if,in,into,is,it,its,(j),(k),(l),(m),me,mi," & _ "mm,my,(n),na,nb,no,not,(o),of,off,ok,on,one,or,our,out,(p),(q),(r),re,(s),she,so,(t),the," & _ "their,them,they,this,to,(u),(v),via,vs,(w),was,we,were,who,will,with,would,(x),(y),yd,you,your,(z)" 'Mac name lower-case list. StrMac = "Macad,Macau,Macaq,Macaro,Macass,Macaw,Maccabee,Macedon,Macerate,Mach,Mack,Macle,Macrame,Macro,Macul,Macumb" StrPunct = "!,;,:,.,?,/,(,{,[,<,“,""" If bClos = True Then StrPunct = StrPunct & ",),},],>,”" If bExcl = False Then StrExcl = "" StrPunct = "" Else StrExcl = " " & Replace(Trim(StrExcl), ",", " , ") & " " End If If Len(Trim(StrTxt)) = 0 Then TitleCase = StrTxt Exit Function End If If bCaps = False Then StrTxt = LCase(StrTxt) StrTxt = " " & StrTxt & " " For i = 1 To UBound(Split(StrTxt, " ")) - 1 StrTmpA = Split(StrTxt, " ")(i) 'Check for a double-quote before the word If Left(StrTmpA, 1) Like "[""“”]" Then StrTmpB = UCase(Left(StrTmpA, 2)) & Right(StrTmpA, Len(StrTmpA) - 2) Else StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1) End If StrTmpB = " " & StrTmpB & " " StrTmpA = " " & StrTmpA & " " StrTxt = Replace(StrTxt, StrTmpA, StrTmpB) Next 'Code for handling hyphenated words For i = 1 To UBound(Split(StrTxt, "-")) StrTmpA = Split(StrTxt, "-")(i) StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1) StrTxt = Replace(StrTxt, StrTmpA, StrTmpB) Next 'Code for handling family names starting with O' For i = 1 To UBound(Split(StrTxt, "'")) If InStr(Right(Split(StrTxt, "'")(i - 1), 2), " ") = 1 Or _ Right(Split(StrTxt, "'")(i - 1), 2) = Right(Split(StrTxt, "'")(i - 1), 1) Then StrTmpA = Split(StrTxt, "'")(i) StrTmpB = UCase(Left(StrTmpA, 1)) & Right(StrTmpA, Len(StrTmpA) - 1) StrTxt = Replace(StrTxt, StrTmpA, StrTmpB) End If Next 'Code for handling family names starting with Mc If Left(StrTxt, 2) = "Mc" Then Mid(StrTxt, 3, 1) = UCase(Mid(StrTxt, 3, 1)) End If i = InStr(StrTxt, " Mc") + InStr(StrTxt, """Mc") If i > 0 Then Mid(StrTxt, i + 3, 1) = UCase(Mid(StrTxt, i + 3, 1)) End If 'Code for handling family names starting with Mac If InStr(1, StrTxt, "Mac", vbBinaryCompare) > 0 Then For i = 1 To UBound(Split(StrTxt, " ")) StrTmpA = Split(StrTxt, " ")(i) If InStr(1, StrTmpA, "Mac", vbBinaryCompare) > 0 Then StrTmpA = Left(StrTmpA, Len(StrTmpA) - InStr(1, StrTmpA, "Mac", vbBinaryCompare) + 1) bFnd = False For j = 0 To UBound(Split(StrMac, ",")) StrTmpB = Split(StrMac, ",")(j) If Left(StrTmpA, Len(StrTmpB)) = StrTmpB Then bFnd = True Exit For End If Next If bFnd = False Then If Len(Split(Trim(StrTmpA), " ")(0)) > 4 Then StrTmpB = StrTmpA Mid(StrTmpB, 4, 1) = UCase(Mid(StrTmpB, 4, 1)) StrTxt = Replace(StrTxt, StrTmpA, StrTmpB) End If End If End If Next End If 'Code to restore excluded words to lower case If StrExcl <> "" Then For i = 0 To UBound(Split(StrExcl, ",")) StrTmpA = Split(StrExcl, ",")(i) StrTmpB = UCase(Left(StrTmpA, 2)) & Right(StrTmpA, Len(StrTmpA) - 2) If InStr(StrTxt, StrTmpB) > 0 Then StrTxt = Replace(StrTxt, StrTmpB, StrTmpA) 'Make sure an excluded words following punctution marks are given proper case anyway For j = 0 To UBound(Split(StrPunct, ",")) StrChr = Split(StrPunct, ",")(j) StrTxt = Replace(StrTxt, StrChr & StrTmpA, StrChr & StrTmpB) Next End If Next End If TitleCase = Trim(StrTxt) End Function Code:
Sub MakeTitle() Application.ScreenUpdating = False Dim StrTmp As String With Selection.Range StrTmp = Trim(.Text) While Right(StrTmp, 1) = "." StrTmp = Left(StrTmp, Len(StrTmp) - 1) Wend While InStr(StrTmp, " ") > 0 StrTmp = Replace(StrTmp, " ", " ") Wend StrTmp = TitleCase(StrTmp, bCaps:=False, bExcl:=False) .Text = StrTmp End With Application.ScreenUpdating = True End Sub Code:
Sub HeadingMakeTitle() Application.ScreenUpdating = False Dim StrTmp As String With ActiveDocument.Range With .Find .MatchWildcards = True .ClearFormatting .Replacement.ClearFormatting .Format = True .Wrap = wdFindStop .Execute Replace:=wdReplaceAll .Style = "Heading 1" .Text = "[!^13]{1,}" .Replacement.Text = "" .Execute End With Do While .Find.Found StrTmp = Trim(.Text) While Right(StrTmp, 1) = "." StrTmp = Left(StrTmp, Len(StrTmp) - 1) Wend While InStr(StrTmp, " ") > 0 StrTmp = Replace(StrTmp, " ", " ") Wend StrTmp = TitleCase(StrTmp, bCaps:=False, bExcl:=False) .Text = StrTmp .Collapse wdCollapseEnd .Find.Execute Loop End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
|||
|
|||
Thanks for the response
Quote:
Neil Brown |
#5
|
|||
|
|||
Macropod,
I know this string is old, but I just found it, and I am trying to use your title case code. However, Word 2016 chocks on this line: StrPunct = "!,;,:,.,?,/,(,{,[,<,",""". Is there a different way to format it? In the forum, it looks like the next to last quote (inside the lasts comma) is a left curly quote. Could that be the issue? Anyway, I just copied and pasted your code into the VBA editor in Word and tried to run it and it stops on the StrPunct line (which I thought it might because it's higlighted in red). Thanks! |
#6
|
|||
|
|||
Quote:
Here is what I'm running from Graham Mayor's vba examples: Code:
Sub TrueTitleCase() ' Graham Mayor ' Graham Mayor vba examples page 2 ' Creates true title case - sort of ' See http://www.gmayor.com/word_vba_examples_2.htm ' 2014-01-31 - tab formatting added to vba by ckk ' Dim sText As range, vFindText As Variant, vReplText As Variant, _ i As Long, k As Long, 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 Save time in word with new buttons that show up where you need them. It gives true title case including the word "you." Save Time in Word with New Buttons That Show Up Where You Need Them. I tried what I have from Paul's code, which does run fine on my computer, and it did not capitalize the "you." (You is in the exclusion list of the function.) Save Time in Word with New Buttons That Show Up Where you Need Them. The difference is in the exclusion lists, I expect. Paul's macro covers more things though. Last edited by Charles Kenyon; 09-15-2020 at 04:14 PM. |
#7
|
||||
|
||||
As posted, it appears you've converted the smart quote to plain quote.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
Ok. Dumb question. How do I paste the smart quote? It may be that I copied the macro to a word doc so I could send it to myself at the office cause I can't access this forum at the office. Anyway, it seems to paste as plain text. Thanks.
|
#9
|
||||
|
||||
The forum software or Word may have already converted it. Just look carefully at the code after you paste it into the VBA editor and replace any single or double quotes which lean over (by deleting and retyping that single character)
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#10
|
|||
|
|||
My grammatical skills may be rusty, but for US use, I use the following exclusion list which does not include pronouns but does include conjunctions and prepositions:
Code:
Let StrExcl = "(a),a,an,and,as,at,(b),be,but,by,(c),cm,(d),(e),eg,en,eq,etc,(f),for," & _ "(g),(h),(i),ie,in,into,(j),(k),(l),(m)," & _ "mm,(n),na,nb,(o),of,off,on,or,(p),(q),(r),re,(s),(t),the," & _ "to,(u),(v),via,vs,(w),with,(x),(y),yd,(z)" |
#11
|
||||
|
||||
You could overtype the offending quote character with Alt-0147
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#12
|
|||
|
|||
Quote:
-Rich |
#13
|
|||
|
|||
Quote:
-Rich |
#14
|
|||
|
|||
Thanks for the add'l info. I tried pasting it into the VBA editor at home and it worked fine so there's something lost in translation by my sending the code to the office so I'll send my template file home and past the code there, which I'm sure will then work.
-Rich |
#15
|
|||
|
|||
Quote:
|
Tags |
text conversion, title case |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
creating a new TITLE property from text already within document | smndnm | Word VBA | 6 | 07-04-2014 08:27 PM |
Stop review query when small case at beginning of line | dsrose | Word | 2 | 01-22-2014 12:19 AM |
True Title Case for First Row of All Tables | Marrick13 | Word VBA | 14 | 12-11-2013 09:12 PM |
Custom Text Filter for this particular case | tinfanide | Excel | 2 | 09-13-2011 05:08 AM |
From all UPPER CASE to Proper Case | davers | Word | 1 | 04-30-2009 12:41 PM |