chr0m3
chr0m3

Reputation: 3

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

Upvotes: 0

Views: 179

Answers (1)

taller
taller

Reputation: 18963

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

Upvotes: 0

Related Questions