[求助]请帮我修改代码以完全达到目的，谢谢！

ssq1109

我本想用下面的代码使附件中的“原始”文档变以“结果”文档，即先根据标记将标记间的内容变为繁体，但它会跳行执行，即只是奇数行执行了，我也知道是第一次执行时把第二行的首标记选中了而跳过了第二行，但不知怎样避免此问题。

Sub Macro1()
'
   Application.ScreenUpdating = False
    Selection.HomeKey Unit:=wdStory
   With Selection.Find
   .ClearFormatting
   .Replacement.ClearFormatting
      Do
        .Execute findtext:="\[HTRW*\](*)\[HT*\]", _
                 replacewith:="^&"
        .MatchWildcards = True
        If .Found = False Then
        Exit Do
        End If
         WordBasic.ToolsSCTCTranslate
        .Parent.Collapse Direction:=wdCollapseEnd
       Loop
   End With
End Sub

还一附加要求，即将文本前加了“[RWO]”,文本后加了“[RW]”(均不含引号)的文本若是繁体汉字就变为简体(因包括这些标记在内的文本还可能被上面所述的标记包含了而先应被转成了繁体)

两种情况的原始标记均不删除。

MIrEwMtI.rar (5.9 KB, 下载次数: 10)

2007-2-13 10:26 上传

点击文件名下载附件
[求助]请帮我修改代码以完全达到目的，谢谢！

[此贴子已经被作者于2007-2-13 10:26:46编辑过]

守柔

我觉得楼主是否应该把你的逻辑思维告诉我们，而不是以你的代码来干扰我们的思路，当然，代码附上更好。

我提个问题：

在你的附件中，出现了三种标记：[HTRWM]、[RWO]、[RW]，它们的结束标记在哪儿？是段落标记吗？还是标点符号？

在你的附件（原始）中，第五第六段落，没有任何标记，结果文档中，它们无需转换成繁体中文，而最后两个段落，也没有任何标记，为何却转化成了繁体中文？

会不会出现其它的组合情况？

谢谢！

[此贴子已经被作者于2007-2-13 7:13:08编辑过]

ssq1109

很对不起，原附件的确会引起误解。我在顶楼已更换了附件，并在其中加了说明。

sylun

对vba我只看懂一点点，只从查找替换角度，看附件两文档，第一次查找替换的特征文本可否改为：
\[HTRW[!^13]{1,}

ssq1109

不知下面的代码是否还有别的问题，或还需要简化？请指点。

Sub Macro1()
'
 '先据标记转繁体
   Application.ScreenUpdating = False
    Selection.HomeKey Unit:=wdStory
   With Selection.Find
   .ClearFormatting
   .Replacement.ClearFormatting
      Do
        .Execute findtext:="\[HTRW*\](*)\[HT([!R?])", _
                 replacewith:="^&"
        .MatchWildcards = True
        If .Found = False Then
        Exit Do
        End If
         WordBasic.ToolsSCTCTranslate
        .Parent.Collapse Direction:=wdCollapseEnd
       Loop
   End With
 '再据标记转简体
  Selection.HomeKey Unit:=wdStory
   With Selection.Find
   .ClearFormatting
   .Replacement.ClearFormatting
      Do
        .Execute findtext:="\[RWO\](*)\[RW\]", _
                 replacewith:="^&"
        .MatchWildcards = True
        If .Found = False Then
        Exit Do
        End If
         WordBasic.ToolsTCSCTranslate Direction:=0, _
             Varients:=0, TranslateCommon:=0
        .Parent.Collapse Direction:=wdCollapseEnd
       Loop
   End With
   Application.ScreenUpdating = True
 
End Sub

[此贴子已经被作者于2007-2-13 12:11:52编辑过]

守柔

请楼主测试一下：

Sub TCSC()
    Dim myRange As Range
    Application.ScreenUpdating = False
    Set myRange = ActiveDocument.Content
Again1:     With myRange.Find
        .ClearFormatting
        .MatchWildcards = True
        .Text = "\[HTRW*\[HT[!R]"
        Do While .Execute = True
            myRange.Select
            myRange.TCSCConverter wdTCSCConverterDirectionSCTC, True, True
            myRange.SetRange myRange.End, ActiveDocument.Content.End - 1
            GoTo Again1
        Loop
    End With
    Set myRange = ActiveDocument.Content
Again2:     With myRange.Find
        .ClearFormatting
        .MatchWildcards = True
        .Text = "\[RWO*\[RW\]"
        Do While .Execute = True
            myRange.Select
            myRange.TCSCConverter wdTCSCConverterDirectionTCSC, True, False
            myRange.SetRange myRange.End, ActiveDocument.Content.End - 1
            GoTo Again2
        Loop
    End With
    Application.ScreenUpdating = True
End Sub

此代码中，发现一个“BUG”，故我加上了SELECT方法。

ssq1109

谢谢守柔大侠！

真是不可思议，我测试时发现是死循环，我怀疑是系统问题，重启后运行问题依旧。也看不出有何问题。

我逐语句测试时，发现到了“说明”中的[HTRW*]标记起，到出现[HT*]＝出现的问题，文档中删除说明后即可通过。怎样避免这个问题呢？

守柔

请楼主再测试一下：

Sub TCSC()
    Dim myRange As Range, lngEnd As Long
    Application.ScreenUpdating = False
    Set myRange = ActiveDocument.Content
Again1:     With myRange.Find
        .ClearFormatting
        .MatchWildcards = True
        .Text = "\[HTRW*\[HT[!R]"
        Do While .Execute = True
            myRange.Select
            lngEnd = myRange.End
            myRange.TCSCConverter wdTCSCConverterDirectionSCTC, True, True
            myRange.SetRange lngEnd, ActiveDocument.Content.End - 1
            GoTo Again1
        Loop
    End With
    Set myRange = ActiveDocument.Content
Again2:     With myRange.Find
        .ClearFormatting
        .MatchWildcards = True
        .Text = "\[RWO*\[RW\]"
        Do While .Execute = True
            myRange.Select
            lngEnd = myRange.End
            myRange.TCSCConverter wdTCSCConverterDirectionTCSC, True, False
            myRange.SetRange lngEnd, ActiveDocument.Content.End - 1
            GoTo Again2
        Loop
    End With
    Application.ScreenUpdating = True
End Sub

ssq1109

That's wonderful! Thanks a lot!

I've seen the adding sentences.