Create a double field through VBA

[frogman]

I am trying to create a field code that looks like this:
{Macrobutton NoMacro {Quote "Insert Number" \* CharFormat}}

but if I just add the text the second Quote is just the text that is
added to the field. so I attempted to create a double field creation
but it failed.

Thank you for your help



Sub TextToFieldClear()
Dim strSelection As String
Dim intWordCount As Integer

Selection.Font.Color = wdColorRed
strSelection = Selection.Text
'intWordCount =
'intWordCount = Selection.Information(wdEndOfRangeRowNumber)

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
Text:="Macrobutton NoMacro " & strSelection & "",
PreserveFormatting:=False
'ActiveDocument.Words.Item(intWordCount).Select
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
Text:="" & strSelection & "" & " \* CharFormat",
PreserveFormatting:=False


Selection.Fields(1).Update

End Sub

 

[Greg Maxey]

Try this:

Sub ScratchMacoro()
Dim myRng As Range
Set myRng = Selection.Range
With myRng
.Collapse wdCollapseEnd
.Fields.Add Range:=myRng, Type:=wdFieldMacroButton,
PreserveFormatting:=False
.Move Unit:=wdWord, Count:=2
.InsertAfter "NoMacro "
.Move Unit:=wdWord, Count:=1
.Fields.Add Range:=myRng, Type:=wdFieldQuote, PreserveFormatting:=False
.Move Unit:=wdWord, Count:=2
.InsertAfter """Insert Number"" \* CharFormat"
End With
End Sub

 

[frogman]

Thank you it helped alot here is your code that I modified to work for
me.

Sub TextToFieldClear()
Dim strSelection As String
Dim myRng As Range
Set myRng = Selection.Range
ActiveWindow.View.ShowFieldCodes = True
strSelection = Selection.Text

With myRng
.Delete
.Collapse wdCollapseEnd
.Fields.Add Range:=myRng, Type:=wdFieldMacroButton,
PreserveFormatting:=False
.Move Unit:=wdWord, count:=2
.InsertAfter "NoMacro "
.Move Unit:=wdWord, count:=1
.Fields.Add Range:=myRng, Type:=wdFieldQuote,
PreserveFormatting:=False
.Move Unit:=wdWord, count:=2
.InsertAfter ("""" & strSelection & """ \* CharFormat")
End With

With Selection
.find.ClearFormatting
.find.Forward = False
.find.MatchCase = True
.find.Text = "Q"
.find.Execute
.Font.Color = wdColorRed
.Fields.Update
End With

ActiveWindow.View.ShowFieldCodes = False
End Sub