如何将原始 Microsoft Word 字段代码复制到另一个文本文档?

如何将原始 Microsoft Word 字段代码复制到另一个文本文档?

是否可以从包含域代码的 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

相关内容