[SOLVED] Target image captions using MS Word VBA

Target image captions using MS Word VBA

I want to scan a report and highlight the cross-references. Highlighting the TypeFields that are references was quite easy.

How do I target the captions of the referenced images? I don't want them to be connected to each other (not yet).

I tried InlineShapes.Caption, which resulted in nothing (InlineShapes works, I can resize and delete images).
I also tried to select the Captions, but with Selection I end up with the images again.
I also tried to extract the caption via InlineShape.Text, no results. As well as InlineShape.Caption.Text, and InlineShape.CaptionLabel.Text, which are all not recognised objects (if I remember correctly).

This is the code that I came up with, which finds references, and highlights them, as well as deletes images.

Sub ReferenceHighlight()
    'Define the range as the whole document
    Dim docRange As Range
    Set docRange = ActiveDocument.Range
    'Define all Fields in the Document
    Dim fld As Word.Field
    'Define an incremental integer
    Dim i As Integer
    i = 1
    'Define all Pictures in the Document
    Dim image As InlineShape
    For Each image In docRange.InlineShapes
        image.Delete
    Next image
    For Each fld In docRange.Fields
        If fld.Type = wdFieldRef Then
             fld.Result.HighlightColorIndex = wdYellow
        End If
    Next fld
End Sub

Solution

Pls try.

    For Each fld In docRange.Fields
        If fld.Type = wdFieldRef Then
            fld.Select
            Selection.Expand xlLine
            Selection.Range.HighlightColorIndex = wdYellow
        End If
    Next fld

A more efficient way to highlight captions. (@Timothy Rylatt posts the comment before my answer)

Sub HightLightCaption()
    Options.DefaultHighlightColorIndex = wdYellow
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Style = ActiveDocument.Styles("Caption")
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Replacement.Highlight = True
        .Execute Replace:=wdReplaceAll
    End With
End Sub