域代码纯文本化及其智能转换

sylun

一直以来，在ＷORD的学习中时常需要将域代码纯文本化为变形域文本，或将变形域文本转换成域代码。在这方面，老大的GetViewFieldCodes和SetViewFieldCodes两个经典程序使我受益良多。最近受Gemj兄帖子的吸引，突发奇想：能否做到域代码与变形域文本间相互智能转换？这样一个程序就可处理，使用起来将更方便。在参考老大程序的基础上，尝试用另一种思路编写。几经测试，总算写出基本代码。
没有详细测试程序的可靠性及适应性。欢迎测试，并提出修改意见。

Sub TransFieldCodes()
'智能判断将转换后的域代码文本（变形域）复制到剪贴板，或将变形域文本转换为域代码
'无选定区域则作全文档处理。对光标位于非主文档文字部分（页眉页脚等）且无选定内容，则处理该文字部分全部内容
Dim SelRange As Range, myRange As Range, TF As Boolean, TF2 As Byte, oText As String
On Error Resume Next
Application.ScreenUpdating = False
TF = ActiveDocument.ActiveWindow.View.ShowFieldCodes  '获取活动文档域代码显示设置
If TF = False Then ActiveDocument.ActiveWindow.View.ShowFieldCodes = True  '显示域代码
With Selection
    If .Type = wdSelectionIP And .StoryType <> wdMainTextStory Then .Expand wdStory
    Set SelRange = .Range  '取得原选定区域范围
    Set myRange = VBA.IIf(.Type = wdSelectionIP, ActiveDocument.Content, .Range)  '确定处理区域
    If .Type = wdSelectionIP Then .HomeKey wdStory Else .Collapse wdCollapseStart  '光标定位初始化
    If myRange.Fields.Count > 0 And VBA.InStr(myRange.Text, "}") Then _
        TF2 = MsgBox("要将域代码转换为变形域吗？", vbYesNo)  '如处理区域既有域也有普通大括号字符时确定处理方式
    If VBA.InStr(myRange.Text, "}") And TF2 <> 6 Then  '变形域转换为域代码
        Do While .MoveUntil("}")  '依次处理每对大括号
            If .End > myRange.End Then Exit Do
            .Delete
            .MoveStartUntil "{", wdBackward
            ActiveDocument.Fields.Add .Range, wdFieldEmpty, , False
            .MoveStartUntil "{", wdBackward
            .Previous.Delete
            '以下循环语句部分用以删除插入域后产生的多余空格
            If .Characters.First = Chr(32) Then
                .Characters(3).Delete
                .Collapse wdCollapseStart
                .Delete
                .MoveEnd
             Else
                .Characters(2).Delete
            End If
            .SetRange .End - 2, .End - 2
            .Delete
        Loop
        ActiveDocument.Fields.Update
    ElseIf myRange.Fields.Count > 0 Then  '域代码替换为变形域文本（不适用于须保留指定内容其余格式的情形）
        oText = myRange.Text
        oText = VBA.Replace(oText, Chr(19), "{")
        oText = VBA.Replace(oText, Chr(21), "}")
        .Text = oText
        .Cut  '将临时插入的变形域文本剪切到剪贴板
    End If
End With
ActiveDocument.ActiveWindow.View.ShowFieldCodes = TF  '还原域代码显示设置
SelRange.Select  '还原选定状态
Application.ScreenUpdating = True
End Sub

[ 本帖最后由 sylun 于 2008-11-14 00:56 编辑 ]

gemj

第一个支持!

cuteword

学习中，支持

tangqingfu

收藏备用!感谢sylun兄的分享!

dsp5000

运行代码出错了

sylun

请dsp5000兄具体指出运行出错的行，最好能提供测试文本内容。

dsp5000

呵呵，保存文件后重新打开，没问题了。好使。

MOWENZHOU

感谢分享，太爱excelhome了，如果EXCELHOME是mm的话......一定多多努力，争取早点配上如此“美女”

飞云楼主

谢谢分享，收下，

kunihiko

不太懂慢慢学习~~~~~~~~~