Sub ResizeIncludePicture()
Dim oField As Field, dFactor As Double
Const cNewWidth = 5
For Each oField In ActiveDocument.Fields
    If oField.Type = wdFieldIncludePicture Then
        With oField.Result.InlineShapes(1)
            dFactor = .Height / .Width
            .Width = CentimetersToPoints(cNewWidth)
            .Height = dFactor * .Width
        End With
    End If
Next
End Sub