Try:
Code:
Sub Demo()
Dim i As Long, Rng As Range, StrAltTxt As String
With ActiveDocument
'Loop through all inlineshapes
For i = 1 To .InlineShapes.Count
'Point our range to the start of the document
Set Rng = .Range(0, 0)
With .InlineShapes(i)
'Point the end our range to the start of the inlineshape
Rng.End = .Range.Start
With Rng
'Look backwards for a Heading 4
With .Find
.Text = ""
.ClearFormatting
.Replacement.Text = ""
.Replacement.ClearFormatting
.Format = True
.Style = wdStyleHeading4
.Forward = False
.Wrap = wdFindStop
.Execute
End With
If .Find.Found = True Then
'If we found a Heading 4, get the text, minus the paragraph end
With .Duplicate
.End = .End - 1
StrAltTxt = .Text
End With
End If
End With
'Add the Heading 4 text as the Alternative Text
.AlternativeText = StrAltTxt
.Title = ""
End With
Next
End With