Capitalize first letter of words 4 characters or greater if certain styles are applied:

Hello, I have some long documents and I want the formatting to appear uniform.  One of the rules I am trying to apply pertains to Headers and Table titles which have one of several styles applied to them.  I would also like the first letter of hyphenated words before and after the hyphen to be capitalized.

Here is an example (just imagine it has one of the relevant styles applied):

Before:
This is an incorrectly Formatted title with a non-randomly inserted hyphenated word.

After
This is an Incorrectly Formatted Title With a Non-Randomly Inserted Hyphenated Word.


The style names of interest are:
Level1Heading
Level2Heading
Level3Heading
Level4Heading
Level5Heading
Level6Heading
Level7Heading
Level8Heading
ChapterHeading
TableTitle
FrontMatterHead


Thank you for any help you can provide experts and I look forward to talking with you,
Bev
BevosAsked:
Who is Participating?
 
aikimarkConnect With a Mentor Commented:
After a second reading of your requirements, I realized that formatting the entire sentence wasn't sufficient. We have to iterate the words and check for both length and the hyphenated word.  This isn't a fool-proof routine, so you need to run it against all the possible text layouts in your documents.

Public Sub RecaseStyles()
    Dim strStyleNames() As Variant
    Dim vItem As Variant
    Dim rngWord As Range
    strStyleNames = Array("Level1Heading", "Level2Heading", "Level3Heading", _
                "Level4Heading", "Level5Heading", "Level6Heading", "Level7Heading", _
                "Level8Heading", "ChapterHeading", "TableTitle", "FrontMatterHead")
    For Each vItem In strStyleNames
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Style = vItem
            .Execute Forward:=True, Format:=True
            Do While .Found = True
                For Each rngWord In .Parent.Words
                    If Len(Trim(rngWord.Text)) > 3 Then
                        rngWord.FormattedText.Case = wdTitleWord
                    End If
                    If rngWord.Text = "-" Then
                        rngWord.Previous(wdWord).FormattedText.Case = wdTitleWord
                    End If
                Next
                .Execute Forward:=True, Format:=True
            Loop
        End With
    Next
End Sub

Open in new window

0
 
aikimarkCommented:
I don't see any way to tweak a style to do this.  :-(

However, you could iterate through the different styles you've listed and go to (Find) each item in your document with that style, changing the case of the found range.
Example:
Public Sub RecaseStyles()
    Dim strStyleNames() As Variant
    Dim vItem As Variant
    strStyleNames = Array("Level1Heading", "Level2Heading", "Level3Heading", _
                     "Level4Heading", "Level5Heading", "Level6Heading", "Level7Heading", _
                     "Level8Heading", "ChapterHeading", "TableTitle", "FrontMatterHead")
    For Each vItem In strStyleNames
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Style = vItem
            .Execute Forward:=True, Format:=True
            Do While .Found = True
               .Parent.FormattedText.Case = wdTitleWord
               .Execute Forward:=True, Format:=True
            Loop
        End With
    Next
End Sub

Open in new window

0
 
BevosAuthor Commented:
Hello, I am very excited to try the solution you posed, but when I do I get an MS Word that stops responding (this is why trying on a small ~20 page document).  Is there a reason why this might be happening for me or is it just too long for this to run?

Thanks,
Bev
0
 
aikimarkCommented:
please post the document you are using for your test.
0
 
aikimarkCommented:
thanks for the points.  Did you resolve the stops-responding behavior?
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.