convert the with statement in VBA into QM code

[macman]

hello everyone,
I found a piece of VBA code that can convert the with statement in VBA into QM code

Step 1: create a new macro in word, and then replace it with the following VBA code VbaWith2Qm
Step 2: Prepare the code that needs processed, copy to the word document
Step 3: run the macro VbaWith2Qm, and the code in the document will be processed

In addition, some modification skills are still needed, which I will add later
enjoy

Sample code I tested:

Code1:

Code:

Copy      Help

 
Sub InsertFormatText()
    Dim rngFormat As Range
    Set rngFormat = ActiveDocument.Range(Start:=0, End:=0)
    With rngFormat
        .InsertAfter Text:="Title"
        .InsertParagraphAfter
        With .Font
            .Name = "Tahoma"
            .Size = 24
            .Bold = True
        End With
    End With
    With ActiveDocument.Paragraphs(1)
        .Alignment = wdAlignParagraphCenter
        .SpaceAfter = InchesToPoints(0.5)
    End With
End Sub

Code2:

Code:

Copy      Help

 
Sub FormatRange()
    Dim rngFormat As Range
    Set rngFormat = ActiveDocument.Range( _
        Start:=ActiveDocument.Paragraphs(1).Range.Start, _
        End:=ActiveDocument.Paragraphs(3).Range.End)
    With rngFormat
        .Font.Name = "Arial"
        .ParagraphFormat.Alignment = wdAlignParagraphJustify
    End With
End Sub

Code3:

Code:

Copy      Help

 
Sub ToggleParagraphSpace()
    With Selection.Paragraphs(1)
        If .SpaceBefore <> 0 Then
            .SpaceBefore = 0
        Else
            .SpaceBefore = 6
        End If
    End With
End Sub

Code4:

Code:

Copy      Help

 
Sub FormatMargins()
    With ActiveDocument.PageSetup
        .LeftMargin = .LeftMargin + InchesToPoints(0.5)
        .RightMargin = .RightMargin + InchesToPoints(0.5)
    End With
End Sub

_____________________________________________________________________________________________________________________________________________________
VBA Macros VbaWith2Qm

Code:

Copy      Help

 
Sub VbaWith2Qm()
    Dim pa As Paragraph, re As Object
    ActiveDocument.Range.Find.Execute "_^13", , , 2, , , , 0, 0, "", 2  'The first 2 decides whether to pass through, and the second decides whether to replace all
    Set re = CreateObject("vbscript.regexp")
    re.Global = 1
    For Each pa In ActiveDocument.Paragraphs
        If InStr(pa.Range, ":=") > 0 Then
            re.Pattern = "\w+:=.+?(?=,)|\w+:=.+(?=\))|\w+:=.+?(?=\r)"
            For Each ma In re.Execute(pa.Range)
                s1 = Split(ma, ":=")(0)
                s2 = Split(ma, ":=")(1)
                
                If ch13 = 0 Then
                    ch13 = ch13 + 1
                    pa.Range.InsertBefore Chr(13)
                End If
                ma = Replace(Replace(ma, "(", "\("), ")", "\)")
                ActiveDocument.Range(pa.Range.Previous.End - 1, pa.Range.Previous.End - 1).InsertAfter "VARIANT " & s1 & "=" & s2 & Chr(13)
                If InStr(pa.Range, "(") > 0 Then
                    pa.Range.Find.Execute "\(" & ma, MatchWildcards:=1, replacewith:="(" & s1, Replace:=1
                    pa.Range.Find.Execute "[ \,]{1,}" & ma, MatchWildcards:=1, replacewith:=" " & s1, Replace:=1
                    pa.Range.Find.Execute ma, replacewith:=s1, Replace:=1
                    If UBound(Split(pa.Range, ":=")) = 0 And pa.Range.Characters.Last.Previous <> ")" Then pa.Range.Characters.Last.Previous.InsertAfter ")"
                ElseIf UBound(Split(pa.Range, ":=")) > 1 Then
                    pa.Range.Find.Execute "[ ,]{1,}" & ma, MatchWildcards:=1, replacewith:="(" & s1, Replace:=1
                Else
                    pa.Range.Find.Execute " " & ma, replacewith:="(" & s1 & ")", Replace:=1
                End If
            Next
            ch13 = 0
        End If
        fi = Split(Trim(pa.Range.Text), " ")(0)
        re.Pattern = "\.\w+\r"
        If re.test(pa.Range) And InStr(pa.Range, "With") = 0 Then
            pa.Range = Replace(pa.Range, Chr(13), "") & "()" & Chr(13)
        ElseIf fi = "With" Then
            tf = tf + 1
            strB = strB & Replace(Split(Trim(pa.Range.Text), " ")(1), Chr(13), "") & "@"
            pa.Range = ""
        ElseIf fi = "Set" Then
            re.Pattern = "\.(\w+)\("
            Set sm = re.Execute(pa.Range)
            strA = sm(0).submatches(0)
            pa.Range.Find.Execute findtext:=fi, replacewith:="word." & strA
        ElseIf Left(Trim(pa.Range), 1) = "." Then
            pa.Range = Replace(strB, "@", "") & Trim(pa.Range)
        ElseIf InStr(pa.Range.Text, " .") > 0 Then
            re.Pattern = "\s\."
            If re.test(pa.Range) Then
                st = re.Execute(pa.Range)(0).firstindex
                ActiveDocument.Range(pa.Range.Start + st + 1, pa.Range.Start + st + 1).InsertAfter Replace(strB, "@", "")
            End If
        ElseIf Replace(Trim(pa.Range), Chr(13), "") = "End With" Then
            tf = tf - 1
            strB = Left(strB, InStrRev(strB, "@", Len(strB) - 2))
            pa.Range = ""
        End If
    Next
    re.MultiLine = 1
    re.ignorecase = 1
    re.Pattern = "^\s+|Then|End If|End Sub"      '|^Sub.+$^\s*Dim.+$"
    Debug.Print re.test(ActiveDocument.Range)
    ActiveDocument.Range = re.Replace(ActiveDocument.Range, "")
End Sub