The following might suffice:
Sub ConvertSelectedFieldsToText()
Call FieldCodeToText(Selection.Range)
ActiveDocument.Undo
End Sub
Function FieldCodeToText(rngOrig As Range)
Dim rng As Range
Dim Colour As WdColorIndex
Dim i As Long
i = 2
Do
If rngOrig.Fields.Count <= 1 Then
' Not more than one field in selection,
' so replace first field in selection
' with its code surrounded by braces
rngOrig.Text = "{" & _
rngOrig.Fields(1).code.Text & "}"
Else
Colour = i
' More than one field in selection,
' move to next field and check again,
' until there's only one field left
Set rng = rngOrig.Duplicate
rngOrig.Fields(2).Select
Selection.Font.ColorIndex = i
Call FieldCodeToText(Selection.Range)
rng.Select
End If
i = i + 1
Loop Until rngOrig.Fields.Count = 0
End Function
Sub ConvertSelectedTextToFields()
Call TextToFieldCodes(Selection.Range)
End Sub
Function TextToFieldCodes(rngOrig As Range)
Dim rng As Range
Dim fld As Field
Dim str As String
Do
Set rng = rngOrig.Duplicate
str = rng.Text
' If there are any braces remaining in the range, except
' for the first and last characters, then there's still
' some pseuodo-fields to process, so collapse range to
' next set of braces and check again
If InStr(Mid(str, 2, Len(str) - 2), "}") <> 0 Or _
InStr(Mid(str, 2, Len(str) - 2), "{") <> 0 Then
' Move the beginning of the range forward
' until it's at a left brace
Do While InStr(Right(str, Len(str) - 1), "{") > 0
rng.MoveStart unit:=wdCharacter, Count:=1
rng.MoveStartUntil cset:="{"
str = rng.Text
Loop
' Move the end of the range backward until it's at a right brace
Do While InStr(Left(str, Len(str) - 1), "}") > 0
rng.MoveEnd unit:=wdCharacter, Count:=-1
rng.MoveEndUntil cset:="}", Count:=-Len(str)
str = rng.Text
Loop
' If either end of the range isn't a brace character,
' there's been an error.
If Left(str, 1) <> "{" Or Right(str, 1) <> "}" Then
GoTo ERR_HANDLER
End If
' Continue searching for brace characters in this range
' with a recursive call to this function
Call TextToFieldCodes(rng)
Else
' No brace characters were found between
' the first and last characters
' If either end of the range isn't a brace character,
' there's been an error.
If Left(str, 1) <> "{" Or Right(str, 1) <> "}" Then
GoTo ERR_HANDLER
End If
' Delete the braces on the ends of the range
rng.Characters(1).Delete
rng.Characters(rng.Characters.Count).Delete
' Cut the range and paste it in as the code
' of a new empty field, which preserves any
' codes in the range, as well as formatting
rng.Cut
Set fld = rng.Fields.Add(Range:=rng, _
Type:=wdFieldEmpty, _
Text:="", _
PreserveFormatting:=False)
fld.code.Paste
End If
' As long as there are braces left in the original range,
' keep trying to turn them into fields
Loop While InStr(rngOrig.Text, "}") <> 0 Or _
InStrRev(rngOrig.Text, "{") <> 0
Exit Function
ERR_HANDLER:
rng.Select
If Left(rng.Text, 1) <> "{" Then
MsgBox "Missing an expected left brace ( { )", vbCritical
ElseIf Right(rng.Text, 1) <> "}" Then
MsgBox "Missing an expected right brace ( } )", vbCritical
Else
MsgBox "An unknown error occurred", vbCritical
End If
End Function
--
Hope this helps.
Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.
Doug Robbins - Word MVP
