Regex + Word Macro for Replacing Styles

Question

I've got a bunch of documents with disparate styles that I've been adding to a long Macro that finds and replaces these styles with the correct ones. Right now, I'm just adding to a list as I find a wrong style. For example, there can be Heading 1, heading 1, H1, or h1. I want to write a find and replace function for each of those for the moment. What would be cooler is if I could write a catch all macro for these sorts of things using Regex: (h|H).{6}\s1 (not the best Regex writer, so bear with that). Ideally that would catch anything the variations of heading 1 (though it would not catch the h1, H1 cases, though I could add that easily enough.

I know that VBA supports Regex. I've added the reference to it. I also know how this would work for replacing specific text. I'm not replacing text though. ONLY formatting. I haven't played around with it too much. I just want to know if I can use the Regex when working specifically with a style. Here's what the functions look like right now:

Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 1")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("SSC TOC 2")
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

I simply recorded that. Now, would I be able to put Regex in place of that string, like so:

Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles(someRegex function (h|H).{6}\s1)
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("SSC TOC 2")
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Basically just using a function someRegex function (h|H).{6}\s1 in place of the string literal. Is there any way to do this? Would appreciate any guidance or help!

While I'm not a fan of regex, I can honestly say that I don't think this is a particularly good problem for it. My recommendation is to create a list of the different possibilities to search for (maybe in a text file, but doesn't have to be). Then use that list to search for the styles. Otherwise, you'll spend a long time stumbling over a regex to get it right and you still may miss other different spellings. I think you'll end up with a list of regexes when it would be simpler to come up with a list of style (mis-)names on your own. — PeterT
I've been thinking about it and it probably would fail ANYWAY because the script dies if the style doesn't exist. So you're probably right. Still would be fun to know. — A. Eakins
One approach would be to get the list of styles that are currently in use in the document and compare that to your substitution list with misspellings. — PeterT
That's a good point. I tried to find the Styles.In.use through the GUI before I started but couldn't. Nice to know I can pull it from VBA. — A. Eakins
To see styles in use using GUI: display styles pane (Alt+Ctrl+Shift+S), click Options, set "Select styles to show" to "In use". You should be aware though that the InUse property can be unreliable, e.g. if you have looped through the Styles collection they will all show as in use. — Timothy Rylatt

macropod macropod · Accepted Answer · 2020-03-10T05:27:52

You could use something along the lines the following macro to delete all unused user-defined Styles (except Linked Styles) in a document, and to clean up the various H1, etc. Styles you mentioned:

Sub CleanUpStyles()
Application.ScreenUpdating = False
Dim Doc As Document, bDel As Boolean, bHid As Boolean
Dim Rng As Range, StlNm As String, i As Long
bHid = ActiveWindow.View.ShowHiddenText
ActiveWindow.View.ShowHiddenText = True
Set Doc = ActiveDocument
With Doc
  For i = .Styles.Count To 1 Step -1
    With .Styles(i)
      If .BuiltIn = False And .Linked = False Then
        bDel = True: StlNm = .NameLocal
        For Each Rng In Doc.StoryRanges
          With Rng
            With .Find
              .ClearFormatting
              .Format = True
              .Style = StlNm
              .Execute
            End With
            If .Find.Found = True Then
              If StlNm Like "[Hh]*#" Then
                If StlNm <> "Heading " & Right(StlNm, 1) Then
                  .Style = "Heading " & Right(StlNm, 1)
                  bDel = True
                End If
              Else
                bDel = False
              End If
              Exit For
            End If
          End With
        Next
        If bDel = True Then .Delete
      End If
    End With
  Next
End With
ActiveWindow.View.ShowHiddenText = bHid
Application.ScreenUpdating = True
End Sub

Regex + Word Macro for Replacing Styles

1 Answers