一个困扰我很长时间的代码转换问题

5ihome

本人编程水平入门，被下面的代码转换问题已经困扰了有快一个月了，期间加入了五六个VBA群，请教高手后均石沉大海，特前来论坛发贴

请教，希望各路高手，能在百忙之中，解决一下，万分感激！要求、结果、代码附上

5ihome

不知道用VBA改VBA代码，合不合理，里面的需要处理的逻辑太多了，希望有高手能提供一些建议或使用其它工具的想法，非常感谢

5ihome

我想的思路是:
1.先处理断行，把断行并成一行
2.再处理With语句，因为with语句会一层套一层，所以要先处理最顶层的with语句，然后再处理下一层……
3.处理带括号的赋值语句
4.删除对象定义的关键词，并换成新的关键词
5.处理不带括号的赋值语句
但是心有余，力不足 ，哎
6.处理对象的属性或方法后面没有赋值的语句，添加()

5ihome

这条想了一下，应该更正为
2.再处理With语句，因为with语句会一层套一层，所以要先最底层的with语句开始，然后再处理上一层……

5ihome

本人使用其他平台语言，操作word VBA，因为语言不支持With语句，不支持断行，不支持直接片断赋值，只能这样更新一下代码才能使用，所以想用个批处理的方法，解决一下！希望高手，支招一下！多谢！

zhanglei1371

Sub df()
Dim pa As Paragraph, re As Object
    ActiveDocument.Range.Find.Execute "_^13", , , 2, , , , 0, 0, "", 2  '第一个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 "virant " & 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
其他的很简单了，自己搞

5ihome

刚刚看到回复，真心感谢您

5ihome

测试了一下，发现：赋值符：=前、后都有同一个单词的情况下（如下图，都有Strart、End）会出现错误，期待楼上的高手能指点一下迷津！万分感谢！
真心感觉正则的高手，应该能很容易解决，本人刚在网上买了本正则指引，还没有收到货，发现玩转查找替换，真该补补正则了！

也希望论坛出版一些针对Word VBA的正则方面的书籍，因为我发现论坛上的有难度的问题，几乎都是清一色的正则问题！

5ihome

如果有三个参数需要赋值，也出现了错误

5ihome

zhanglei1371 发表于 2017-3-19 21:44
难度倒是不难，就是繁琐，粗略写了些，不想写了：
Sub df()
Dim pa As Paragraph, re As Object

您好，因为我刚注册，不能发消息，所以在这里回复一下：
您编写的代码，基本上没有什么问题，就是对多个参数的识别上有点小问题
另外，后期我也要在用一些kootools插件进行优化，怕到时候有影响，所以把优化代码的注意事项，也写在了下面，希望能一并处理一下。
你我素不相，如此热心帮助，感激涕零，无以言表！

注意事项：
1.有时会有多个参数赋值，所以要考虑到多个,号的识别，如：三个参数是两个逗号，四个参数是三个逗号……
2.有时变量值和变量值的最后一个字段是相同，如：代码5中的Start End Text

优化代码事项：
删除所有 Dim……所在行 语句
删除所有 Sub……所在行 语句
删除所有 End Sub所在行 语句
删除所有 Then 单词
删除所有 End If 所在行 语句
删除所有行前面的缩进，即：所有行左对齐
所有ActiveDocument.替换为ad.
所有Application.替换为wd.
所有=ture结尾的行替换为= 1
所有= ture结尾的行替换为= 1