|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Capitalization macro doesn't work for hyphenated words or words after paretheses
I have the following macro, which checks each paragraph for specific heading styles, and follows capitalization rules I set. When checking for capitalization in the heading styles, I've tried various ways to check for hyphens and parentheses but I can't get it to capitalize the second word following the hyphen or a word following a parenthesis (e.g., High-profile won't cap "profile" and Table 4 (continued) won't cap "continued") because it's not recognizing it as a different word separated by a space.
What am I missing here? I've highlighted the section of the code below that's currently not working. Thanks so much for the help. Sub CapitalizeHeading() Dim para As Paragraph Dim paraRange As Range Dim excludedWords As Variant Dim headingWords() As String Dim I As Integer Dim j As Integer Dim k As Integer Dim wordFound As Boolean Dim totalPara As Integer Dim originalStyle As String Dim originalUserTrackedRevisions As Boolean 'List of word to be excluded from capitalization excludedWords = Split("a, above, across, against, along, among, an, and, around, as, at, because, before, behind, below, beneath, beside, between, beyond, but, by, down, during, for, from, in, into, nor, of, off, on, onto, or, over, per, since, so, the, through, to, toward, under, unless, with, within, without, yet", ", ") 'Turn off screen updating for efficiency Application.ScreenUpdating = False 'Store user's track changes status originalUserTrackedRevisions = ActiveDocument.TrackRevisions 'Turn on tracked changes ActiveDocument.TrackRevisions = True totalPara = ActiveDocument.Paragraphs.Count For k = 1 To totalPara Set para = ActiveDocument.Paragraphs(k) Set paraRange = para.Range paraRange.MoveEnd unit:=wdCharacter, Count:=-1 ' Exclude the paragraph mark originalStyle = para.Style ' Storing original style Application.StatusBar = "Processing paragraph " & k & " of " & totalPara If para.Style = "Heading 1" _ Or para.Style = "Heading 2" _ Or para.Style = "Heading 3" _ Or para.Style = "Report Title" _ Or para.Style = "Report Subtitle" _ Or para.Style = "Figure/Table Title" Then Dim originalWords As String originalWords = paraRange.text 'Store original paragraph text to compare to changed text headingWords = Split(paraRange.text, " ") For I = LBound(headingWords) To UBound(headingWords) wordFound = False Dim result As String result = "" ' Clear result for each new word Dim makeUpper As Boolean makeUpper = True ' Start with True to capitalize the first letter Dim currentWord As String 'To monitor when tracked changes should be used currentWord = headingWords(I) ' Check if the word should be excluded from capitalization For j = LBound(excludedWords) To UBound(excludedWords) If LCase(headingWords(I)) = LCase(excludedWords(j)) Then wordFound = True Exit For End If Next j ' Handle first and last words, or words with multiple capital letters If I = LBound(headingWords) Or I = UBound(headingWords) Then If Not headingWords(I) = UCase(headingWords(I)) And Not headingWords(I) = LCase(headingWords(I)) Then headingWords(I) = headingWords(I) ' Keep as is ElseIf headingWords(I) = UCase(headingWords(I)) Then headingWords(I) = headingWords(I) ' Keep as is if acronym Else ' Special word handling For j = 1 To Len(headingWords(I)) Dim ch As String ch = Mid(headingWords(I), j, 1) If makeUpper Then ch = UCase(ch) makeUpper = False Else ch = LCase(ch) End If If ch = "-" Or ch = "(" Then makeUpper = True result = result & ch Next j headingWords(I) = result End If ElseIf Not wordFound Then headingWords(I) = UCase(Left(headingWords(I), 1)) & Mid(headingWords(I), 2) Else headingWords(I) = LCase(headingWords(I)) End If Next I alteredWords = Join(headingWords, " ") If originalWords <> alteredWords Then ' Only apply track changes if there is a difference ActiveDocument.TrackRevisions = True paraRange.text = alteredWords ActiveDocument.TrackRevisions = False End If 'Restoring original style para.Style = originalStyle 'Restoring track changes status ActiveDocument.TrackRevisions = originalUserTrackedRevisions End If Next k Application.StatusBar = False Application.ScreenUpdating = True End Sub |
#2
|
|||
|
|||
Hi! Since "-" is a word, try the following basic code (without the exclusion check):
Code:
Sub Test() Dim para As Paragraph Dim oWd As range Application.ScreenUpdating = False For Each para In ActiveDocument.range.Paragraphs If para.Style = "Heading 1" _ Or para.Style = "Heading 2" _ Or para.Style = "Heading 3" _ Or para.Style = "Report Title" _ Or para.Style = "Report Subtitle" _ Or para.Style = "Figure/Table Title" Then For Each oWd In para.range.words oWd.Select If oWd = "-" Or oWd = "(" Then selection.Characters.Last.Next = UCase(selection.Characters.Last.Next) End If Next oWd End If Next para Application.ScreenUpdating = True End Sub |
#3
|
|||
|
|||
I could be missing something, but your code seems to be doing a lot of extraneous work.
Would this do? Code:
Sub CapitalizeHeading() Dim arrExcludedWords() As String Dim colExclude As New Collection Dim lngCount As Long, lngPar As Long, lngIndex As Long Dim oRng As Range Dim oPar As Paragraph Dim bTC As Boolean Application.ScreenUpdating = False 'List of word to be excluded from capitalization arrExcludedWords = Split("a, above, across, against, along, among, an, and, around, as, at, because, before, behind, below, beneath, beside, between, beyond, but, by, down, during, for, from, in, into, nor, of, off, on, onto, or, over, per, since, so, the, through, to, toward, under, unless, with, within, without, yet", ", ") 'Add words to collection. Makes it more efficient to check if each word is excluded. For lngIndex = 0 To UBound(arrExcludedWords) colExclude.Add arrExcludedWords(lngIndex), arrExcludedWords(lngIndex) Next lngIndex 'Store user's track changes status bTC = ActiveDocument.TrackRevisions 'Turn on tracked changes ActiveDocument.TrackRevisions = True lngCount = ActiveDocument.Paragraphs.Count For lngPar = 1 To lngCount Set oPar = ActiveDocument.Paragraphs(lngPar) oPar.Range.MoveEnd unit:=wdCharacter, Count:=-1 ' Exclude the paragraph mark Application.StatusBar = "Processing paragraph " & lngPar & " of " & lngCount Select Case oPar.Style Case "Heading 1", "Heading 2", "Heading 3", "Report Title", "Report Subtitle", "Figure/Table Title" For lngIndex = 1 To oPar.Range.Words.Count Set oRng = oPar.Range.Words(lngIndex) If lngIndex = 1 Then If oRng.Characters(1).Text Like "[a-z]" Then oRng.Characters(1).Text = UCase(oRng.Characters(1).Text) End If Else If oRng.Words.Last.Next = "-" Then oRng.MoveEnd wdWord, 1 lngIndex = lngIndex + 1 End If On Error Resume Next colExclude.Add Trim(oRng.Text), Trim(oRng.Text) If Err.Number = 0 Then colExclude.Remove (colExclude.Count) If oRng.Characters(1).Text Like "[a-z]" Then oRng.Characters(1) = UCase(oRng.Characters(1)) End If Else Err.Clear 'Skip it is an excluded word. End If End If Next End Select Next lngPar ActiveDocument.TrackRevisions = bTC Application.StatusBar = False Application.ScreenUpdating = True lbl_Exit: Exit Sub End Sub |
#4
|
|||
|
|||
I'm pretty sure the problem is due to words with hyphens or in parentheses not being processed correctly. To handle such words correctly, you need to change the logic of your code.
|
#5
|
||||
|
||||
Motherhood statements are unhelpful. Unless you can recommend specific code changes, all you're doing is adding clutter.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
capitalization, hyphenation |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Replace any UK Words to US words in the entire document | laith93 | Word VBA | 4 | 12-25-2023 01:56 AM |
Macro to insert certain words if the number of words than 20 | laith93 | Word VBA | 6 | 10-28-2022 01:12 AM |
How to find (highlight) two and more words in a list of 75k single words in Word 2010 | Usora | Word | 8 | 05-29-2018 03:34 AM |
How to mark underlined words in a sentence as A, B, C, D (beneath the words) | thudangky | Word | 13 | 12-12-2013 02:22 AM |
Why Words doesn’t show the style of the selected words automatically???? | Jamal NUMAN | Word | 0 | 04-14-2011 03:20 PM |