In which field the cursor is? (ms word, vba)

Question

In a VBA Word macro, I'd like to get a Field-object for the field which contains the cursor.

The obvious try fails:

Private Sub Try1()
    MsgBox Selection.Fields.Count
End Sub

The array is empty. Then I tried:

Private Sub Try2()
    Dim oRange As Range
    Set oRange = Selection.GoTo(What:=wdGoToField)
    MsgBox oRange
End Sub

The cursor does not move, the message is empty.

I can iterate over ActiveDocument.Fields, compare the ranges and find the containing fiels. But probably there is a simple direct way?

Answer 1

My current production code with iteration over Document.Fields:

Sub Test()
    Dim oField As Field
    Set oField = FindWrappingField(Selection.Range)
    If oField Is Nothing Then
        MsgBox "not found"
    Else
        MsgBox oField
    End If
End Sub

Private Function FindWrappingField(vRange As Range)
    Dim oField As Field
    Dim nRefPos As Long
    ' If selection starts inside a field, it also finishes inside.
    nRefPos = vRange.Start
    ' 1) Are the fields sorted? I don't know.
    '    Therefore, no breaking the loop if a field is too far.
    ' 2) "Code" goes before "Result", but is it forever?
    For Each oField In vRange.Document.Fields
        If ((oField.Result.Start <= nRefPos) Or (oField.Code.Start <= nRefPos)) And _
            ((nRefPos <= oField.Result.End) Or (nRefPos <= oField.Code.End)) Then
                Set FindWrappingField = oField
                Exit Function
        End If
    Next oField
    Set FindWrappingField = Nothing
End Function

Answer 2

I use this code

Sub GetFieldUnderCursor()
Dim NumberOfFields As Integer
Dim oFld As Field
Dim TextFeld As String
Dim Typ As Integer
Dim pos As Integer
Dim NameOfField As String
'update field. Cursor moves after the field
Selection.Fields.Update
'select the field
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'check if there is a field
NumberOfFields = Selection.Fields.Count
If NumberOfFields = 0 Then
    MsgBox "No field under cursor"
    Exit Sub
End If
Set oFld = Selection.Fields(1)
TextFeld = Trim(oFld.Code.Text)
Typ = oFld.Type '85 is DOCPROPERTY, 64 is DOCVARIABLE
If Typ = 85 Or Typ = 64 Then
    pos = InStr(15, TextFeld, " ")
    If pos > 0 Then
        NameOfField = Trim(Mid(TextFeld, 12, pos - 11))
        MsgBox NameOfField
    End If
End If

End Sub

Answer 3

I had the same problem and I solved with the code below:

Sub Test()
    NumberOfFields = Selection.Fields.Count
    While NumberOfFields = 0
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        NumberOfFields = Selection.Fields.Count
    Wend
End Sub

Of course, I have to know that the cursor is in a field. Apparently, when you select a range extending to the right, at some moment the field will be selected. The end of the range doesn't count (it not acuses a field range)

Answer 4

The following function determines whether the selection spans or is within a field.

Function WithInField(Rng As Word.Range) As Boolean
' Based on code by Don Wells: http://www.eileenslounge.com/viewtopic.php?f=30&t=6622
' Approach  : This procedure is based on the observation that, irrespective of _
              a field's ShowCodes state, toggling the field's ShowCodes state _
              twice collapses the selection to the start of the field.
Dim lngPosStart As Long, lngPosEnd As Long, StrNot As String
WithInField = True
Rng.Select
lngPosStart = Selection.Start
lngPosEnd = Selection.End
With Selection
  .Fields.ToggleShowCodes
  .Fields.ToggleShowCodes
  ' Test whether the selection has moved; if not, it may already have been _
    at the start of a field, in which case, move right and test again.
  If .Start = lngPosStart Then
    .MoveRight
    .Fields.ToggleShowCodes
    .Fields.ToggleShowCodes
    If .Start = lngPosStart + 1 Then
      WithInField = False
    End If
  End If
End With
End Function

You can use the function with code like:

Sub TestWithInField()
Dim Rng As Word.Range, c As Word.Range, StrRslt As String
Set Rng = Selection.Range
For Each c In Rng.Characters
    StrRslt = StrRslt & c.Text & ",WithInField:" & WithInField(Rng:=c) & vbCr
Next
Rng.Select
MsgBox StrRslt
End Sub