是否可以从包含域代码的 Word 文档中复制文本,以便当粘贴到另一个应用程序时,域代码仍保留为原始文本,例如
This is about whales { XE "Cetations:Whales" }. This is about dolphins { XE "Cetations:Dolphins" }.
而不是删除字段代码?
答案1
特伍德的评论是正确的,解决方案来自集成商IT所有格式都会丢失。以下宏字段转文本将文档中的所有字段用其字段代码替换为原始文本,无需触及格式。
第二个宏文本转字段表示相反的方式:将原始代码转换为字段。它会查找模式{ * }
并尝试将其转换为字段。它适用于从第一个宏插入的字段原始文本,但如果文本中其他地方存在花括号和空格的组合,而这些组合并不表示(以前的)字段函数,则可能会产生意想不到的结果。
Sub FieldToText()
'Selection.HomeKey Unit:=wdStory ' to start from top of document
ActiveWindow.View.ShowFieldCodes = True
Do
With Selection.Find
.Text = "^d"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Found = False Then Exit Do
Selection = "{ " & Mid(Selection, 3, Len(Selection) - 2 - 2) & " }"
Selection.Move wdCharacter, 1
Loop While True
End Sub
Sub TextToField()
Dim code As String
'Selection.HomeKey Unit:=wdStory ' to start from top of document
Do
With Selection.Find
.Text = "\{ * \}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Found = False Then Exit Do
code = Mid(Selection, 3, Len(Selection) - 2 - 2)
Selection.Cut
Selection.InsertAfter (code)
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.MoveRight Unit:=wdWord, Count:=1
Loop While True
End Sub
答案2
将宏添加到文档,选择文本,运行宏。现在您可以将字段代码复制到剪贴板。
附言:在Office 2010+中ALT用于F9显示字段代码。
Sub StuffFieldCode()
Dim sField As String
Dim sTextCode As String
Dim bSFC As Boolean
Dim MyData As DataObject
Dim sTemp As String
Dim J As Integer
Application.ScreenUpdating = False
If Selection.Fields.Count = 1 Then
bSFC = Selection.Fields.Item(1).ShowCodes
Selection.Fields.Item(1).ShowCodes = True
sField = Selection.Text
sTextCode = ""
For J = 1 To Len(sField)
sTemp = Mid(sField, J, 1)
Select Case sTemp
Case Chr(19)
sTemp = "{"
Case Chr(21)
sTemp = "}"
Case vbCr
sTemp = ""
End Select
sTextCode = sTextCode & sTemp
Next J
Set MyData = New DataObject
MyData.SetText sTextCode
MyData.PutInClipboard
Selection.Fields.Item(1).ShowCodes = bSFC
End If
Application.ScreenUpdating = True
End Sub
答案3
按Alt+F9显示字段代码,然后突出显示花括号内的所有文本{ }
。然后您可以复制并粘贴此文本。
这是某人编写的可以完成所有工作的宏的链接:复制并粘贴域代码
答案4
有时我会对模组感到疑惑...编辑被拒绝 - 要求做出新的答案...这修复了上面的逻辑/拼写错误。
特伍德的评论是正确的,解决方案来自集成商IT所有格式都会丢失。以下宏字段转文本将文档中的所有字段用其字段代码替换为原始文本,无需触及格式。
第二个宏文本转字段表示相反的方式:将原始代码转换为字段。它会查找模式{*}
并尝试将其转换为字段。它适用于从第一个宏插入的字段原始文本,但如果文本中其他地方存在花括号和空格的组合,而这些组合并不表示(以前的)字段函数,则可能会产生意想不到的结果。
Sub FieldToText()
'Selection.HomeKey Unit:=wdStory ' to start from top of document
ActiveWindow.View.ShowFieldCodes = True
Do
With Selection.Find
.Text = "^d"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Found = False Then Exit Do
Selection = "{ " & Mid(Selection, 3, Len(Selection) - 2 - 2) & " }"
Selection.Move wdCharacter, 1
Loop While True
End Sub
Sub TextToField()
Dim code As String
'Selection.HomeKey Unit:=wdStory ' to start from top of document
Do
With Selection.Find
.Text = "\{*\}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Found = False Then Exit Do
code = Selection
code = Left(code, Len(code) - 1)
code = Right(code, Len(code) - 1)
code = Trim(code)
Selection.Cut
Selection.InsertAfter (code)
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.MoveRight Unit:=wdWord, Count:=1
Loop While True
End Sub