求助：按条件查找替换并保留文本格式（加点字、下划线等）

chinamath

如题，按选项ABCD字符长度，整齐排列ABCD选项到指定的位置（一行）

关键是要保留选项文本的格式（比如下划线、着重号等）


谢谢！


代码如下：



Sub 选项ABCD对齐设置保留格式()

    Dim mydoc As Document
    Dim Rng As Range
    Dim Rng1 As Range
    Dim Rng2 As Range
    Dim Rng3 As Range
    Dim Rng4 As Range
    Dim a, b, c, d
    Set mydoc = ActiveDocument
        With mydoc.Content.Find
        .Text = "(A．[!^13]{1,})^13(B．[!^13]{1,})^13(C．[!^13]{1,})^13(D．[!^13]{1,})^13"
        .MatchWildcards = True
        Do While .Execute
            Set Rng = .Parent
            Set Rng1 = Rng.Paragraphs(1).Range
            Set Rng2 = Rng.Paragraphs(2).Range
            Set Rng3 = Rng.Paragraphs(3).Range
            Set Rng4 = Rng.Paragraphs(4).Range
            a = Len(StrConv((Rng1.Text), vbFromUnicode)) - 1
            b = Len(StrConv((Rng2.Text), vbFromUnicode)) - 1
            c = Len(StrConv((Rng3.Text), vbFromUnicode)) - 1
            d = Len(StrConv((Rng4.Text), vbFromUnicode)) - 1

            ‘MsgBox a & Chr(9) & b & Chr(9) & c & Chr(9) & d

            If a < 20 And b < 20 And c < 20 And d < 20 Then
                If a >= 10 Then
                    If c >= 10 Then
                        .Replacement.Text = "^t\1^t\2^13^t\3^t\4^13"
                    Else
                        .Replacement.Text = "^t\1^t\2^13^t\3^t^t\4^13"
                    End If
                Else
                    If c >= 10 Then
                        .Replacement.Text = "^t\1^t^t\2^13^t\3^t\4^13"
                    Else
                        If b >= 10 Or d >= 10 Then
                            .Replacement.Text = "^t\1^t^t\2^13^t\3^t^t\4^13"
                        Else
                            .Replacement.Text = "^t\1^t\2^t\3^t\4^13"
                        End If
                    End If
                End If
            Else
                .Replacement.Text = "^t\1^13^t\2^13^t\3^13^t\4^13"
            End If
            Rng.Move 4
        Loop
    End With

    mydoc.Content.Find.Execute Replace:=wdReplaceAll

End Sub


word2003，运行后却没有任何结果，问题到底出在何处？请明师直言相告啊，在此先谢谢各位先进！

chinamath

抱歉！初次发帖，竟然忘了想要达到的效果文档，在此补充附件。

gbgbxgb

chinamath 发表于 2019-8-7 17:34
抱歉！初次发帖，竟然忘了想要达到的效果文档，在此补充附件。

没看你的效果文档，你说把选项弄成一行那就一行吧。不需要写代码，简单的几次替换就可以了：


注意，在\1\2的后面添加了不可见的中文空格符。

chinamath

gbgbxgb 发表于 2019-8-7 17:53
没看你的效果文档，你说把选项弄成一行那就一行吧。不需要写代码，简单的几次替换就可以了：

根据选项的长短，效果为：有的是一行，有的是两行，有的是4行（保持不变）

daibao88

针对每次匹配的选项长度逐个判断，逐个替换，应放到循环里替换 .Execute Replace:=wdReplaceOne

chinamath

daibao88 发表于 2019-8-8 22:03
针对每次匹配的选项长度逐个判断，逐个替换，应放到循环里替换 .Execute Replace:=wdReplaceOne

谢谢您！真是太巧啦，我从不知道有这个命令。

但昨天下午，无奈之下我就把All改了one，奇迹出现啦！

xkqtdzj

我的运行结果怎么是这样的？如下图，两行的情况没对齐。

chinamath

xkqtdzj 发表于 2019-8-9 14:07
我的运行结果怎么是这样的？如下图，两行的情况没对齐。

重新设置段落即可

wdpfox

个人觉得字星个数应体现出汉字与英文的区别