Microsoft Office Forums - View Single Post - VBA Word - Find & Apply Styles to Specific Words

jc491 · 12-17-2015, 11:03 AM

Hi,

greetings to all on the forum this day / evening.

I am trying to apply the CASE in VBA to some words that need styling.

I have a document that has specific words which each need to have a different style applied to them.

I thought the case statement would be the best approach?

So for example - specific words in the document will have an identifier in front of them we will use the hash # and a number.

#1apples

#3pears

#4grapes

Word has in front | Apply Style
===============================
#1 | Strong
#2 | Heading 1
#3 | Character Style 1
#4 | italic
#5 | Character Style 2
=================================

I then need to find these words and then apply the correct style to the word.

I'm not sure if an if else or a case would be the best.

I have been using individual macros to plod along, but its really inefficient - I have to call 10 macros on one document, and then I have 50 documents to go through, I'm starting to forget which one I applied where.

My non working version and attempt -

Code:

Sub FindAndApplyStyles()

'Find Words in Document - Apply Style

    
    Set Range = Selection.Range
    Dim rng As Range
    
    For Each rng In Range.Words
    Set rngStyle = rng.Style
        
    Select Case rangeStyle
        
    
    
    Case "Strong"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("Strong")
    With Selection.Find
        .Text = "(#)[1][A-z]{1,}"             ' Find the # sign followed by a number 1 > followed by any characters A-Z at least once
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll


        
    Case "Italic"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("italic")
    With Selection.Find
        .Text = "(#)[4][A-z]{1,}"             ' Find the # sign followed by a number 4 > followed by any charcters A-Z at least once
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
        
    
    Some more Cases.........etc
        
        Case Else
        
        do nothing
            
            
        End Select
    Next rng
    
  
End Sub

As you can see it's a bit heavy - I'm sure I'm not meant to be repeating that much code. I believe I maybe missing some arguments somewhere.

I would really appreciate the help.

As always thank you so much in advance for the time taken to look over this problem.

J