以下为全部代码,供参考:
'* +++++++++++++++++++++++++++++ '* Created By I Love You_Word!@ExcelHome 2005-2-28 14:46:36 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* ----------------------------- Sub GetViewFieldCodes() '此程序仅为说明所选部分的域代码情况,因受复制与粘贴的自动转换影响 '通过此程序,可将WORD文档中的域代码复制后直接贴到网页上,自动转化为 '可视的域代码 '仅适用于主文档文字部分(页眉页脚等视图中的域无效,可复制到主文档中) Dim SelStart As Long, SelEnd As Long, DocEnd As Long, MyRange As Range Dim aString As String, MyString As String, aChar As Range, TF As Boolean On Error Resume Next With ActiveDocument DocEnd = .Content.End '文档结束位置 With Selection '未选定域文本,则提示后退出程序 If .Fields.Count = 0 Then MsgBox "WORD未找到选定文本中包含域!", _ vbOKOnly + vbInformation, "Warning": Exit Sub SelStart = .Start '起点 '如果为文档结束,则-1,否则为选定部分的结尾 SelEnd = VBA.IIf(.End = DocEnd, DocEnd - 1, .End) End With '返回文档是否是处于域代码显示状态 TF = .ActiveWindow.View.ShowFieldCodes '如果为显示域结果,则切换为显示域代码 If TF = False Then .ActiveWindow.View.ShowFieldCodes = True '定义所选区域 Set MyRange = .Range(SelStart, SelEnd) With MyRange '在定义的区域中循环 For Each aChar In MyRange.Characters aString = VBA.IIf(Asc(aChar) = 19, "{", VBA.IIf(Asc(aChar) = 21, "}", aChar)) MyString = MyString & aString '文本值累加 Next '插入变形域代码 Selection.InsertAfter "变形域代码为: " & MyString End With '重新定义一个MyRange对象 Set MyRange = .Range(SelEnd, Selection.End) MyRange.Cut '剪切 '恢复原有状态 If TF = False Then .ActiveWindow.View.ShowFieldCodes = False End With End Sub '---------------------- Sub SetViewFieldCodes() '本代码可用于GetViewFieldCodes()代码执行结果,转化为WORD的域代码. '也适用于WORD帮助文件中复制的域代码(也是变形域),直接转化为WORD中的域代码 Dim SelStart As Long, SelRange As Range, NewSelStart As Long Dim i As Range, MyPost As Long On Error Resume Next Application.ScreenUpdating = False With Selection If .Fields.Count > 0 Then Exit Sub '如果存在域则退出 SelStart = .Start '定义一个起始位置 Set SelRange = .Range '定义一个区域为选定区域 End With While InStr(SelRange, "{") > 0 '设置如果指定区域中含有"{"则进入循环 NewSelStart = SelStart '定义一个开始位置 Set i = ActiveDocument.Range(NewSelStart, NewSelStart + 1) While i <> "}" '设置如果i的文本值不是为"}"则进入循环 Set i = ActiveDocument.Range(NewSelStart, NewSelStart + 1) '重新定义i的区域 NewSelStart = NewSelStart + 1 '将i的起点位置下移一个字符位置 If i = "{" Then MyPost = NewSelStart - 1 '取得当i="{"的位置 Wend '定义一个新区域 Set MyRange = ActiveDocument.Range(MyPost, NewSelStart) With MyRange .Characters(1) = " " '将{改为空格 .Characters(.Characters.Count) = " " '将}改为空格 .Select '选定 End With Application.Run "InsertFieldChars" '插入域标志 Wend Application.ScreenUpdating = True '恢复屏幕更新 End Sub '----------------------
b4H29WBL.rar
(32.85 KB, 下载次数: 171)
[此贴子已经被konggs于2006-12-26 19:51:49编辑过] |