Now the operation is more convenient
However,
still need to open the word software,
create a new macro VbaWith2Qm,
Copy the code to be processed into the Word Client,
finally execute macro9
_________________________________
In QM code:
Clear lines beginning with Dim and Sub
Macro Macro9
However,
still need to open the word software,
create a new macro VbaWith2Qm,
Copy the code to be processed into the Word Client,
finally execute macro9
_________________________________
In QM code:
Clear lines beginning with Dim and Sub
Sub VbaWith2Qm()
Dim pa As Paragraph, re As Object
ActiveDocument.Range.Find.Execute "_^13", , , 2, , , , 0, 0, "", 2
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, "")
ActiveDocument.Content.Copy
End Sub
Macro Macro9
;/exe 1
;Use /exe 1 to run the macro in separate process, as User. This macro may not work without it.
typelib Word {00020905-0000-0000-C000-000000000046} 8.0
Word.Application app._getactive
app.Visible = TRUE
Word.Document doc=app.ActiveDocument
app.Run("VbaWith2Qm")
_s.getclip
;Replace some keywords
_s.findreplace("True" "TRUE") ;;replace True
_s.findreplace("ActiveDocument" "doc") ;;replace ActiveDocument
_s.findreplace("Paragraphs(" "Paragraphs.Item(") ;;replace Paragraphs(
_s.findreplace("InchesToPoints(" "app.InchesToPoints(") ;;replace InchesToPoints(
_s.findreplace("If" "if") ;;replace If
_s.findreplace("Else" "else") ;;replace Else
;Add word app statement
str s=
;;/exe 1
;;Use /exe 1 to run the macro in separate process, as User. This macro may not work without it.
;typelib Word {00020905-0000-0000-C000-000000000046} 8.0
;Word.Application app._getactive
;app.Visible = TRUE
;Word.Document doc=app.ActiveDocument
s.addline(_s)
mes s "QM code has been put on the clipboard"
s.setclip