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:
Code2:
Code3:
Code4:
_____________________________________________________________________________________________________________________________________________________
VBA Macros VbaWith2Qm
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:
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 SubCode2:
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 SubCode3:
Sub ToggleParagraphSpace()
With Selection.Paragraphs(1)
If .SpaceBefore <> 0 Then
.SpaceBefore = 0
Else
.SpaceBefore = 6
End If
End With
End SubCode4:
Sub FormatMargins()
With ActiveDocument.PageSetup
.LeftMargin = .LeftMargin + InchesToPoints(0.5)
.RightMargin = .RightMargin + InchesToPoints(0.5)
End With
End Sub_____________________________________________________________________________________________________________________________________________________
VBA Macros VbaWith2Qm
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