Is it possible to copy text from a Word document containing field codes, so that when pasted into another application, the FIELD CODES REMAIN AS RAW TEXT, i.e. something like
This is about whales { XE "Cetations:Whales" }. This is about dolphins { XE "Cetations:Dolphins" }.
rather than have the field codes stripped out?
TWood's comment is correct that with the solution from integratorIT all formatting is lost. The following macro FieldToText REPLACES all fields in your document with their field codes as raw text WITHOUT touching formatting.
The second macro TextToField is for the opposite way: raw code to fields. It looks for the pattern { * } and tries to convert that to a field. It will work for the fields' raw texts inserted from the first macro, but it may give unpredicted results if there are those combinations of curly braces and whitespace somewhere else in the text where they do not indicate a (former) field function.
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
Add macro to document, select text, run macro. You can now copy field codes to the clipboard.
Ps.: In Office 2010 ALT+F9 is used to display field codes.
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
Press Alt+F9 to show the field code, then highlight all the text inside the curly braces { }. You can then copy and paste this text.
Here's a link to a macro someone wrote to do all the work: Copy and Pasting Field Codes
Sometimes I wonder about the mods... Edit was rejected - told to make new answer... This fixes a logical/typo error above.
TWood's comment is correct that with the solution from integratorIT all formatting is lost. The following macro FieldToText REPLACES all fields in your document with their field codes as raw text WITHOUT touching formatting.
The second macro TextToField is for the opposite way: raw code to fields. It looks for the pattern {*} and tries to convert that to a field. It will work for the fields' raw texts inserted from the first macro, but it may give unpredicted results if there are those combinations of curly braces and whitespace somewhere else in the text where they do not indicate a (former) field function.
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
