The following macro embeds all Shapes & InlineShapes in a document in tables as InlineShapes with a row for Captions. Whatever positioning applied to the original Shape object will apply to the table also.
As specified, the macro sets the inserted image heights to 2in.
Sub MakeImageTables()
Dim iShp As InlineShape, Rng As Range, Tbl As Table
Dim i As Long, PicWdth As Single, PicHght As Single, VPos As Single
Dim HPos As Single, VRel As Long, HRel As Long, BShp As Boolean
PicHght = InchesToPoints(2)
With ActiveDocument
For i = 1 To .InlineShapes.Count
If .InlineShapes(i).Range.Information(wdWithInTable) = False Then
With .InlineShapes(i)
.LockAspectRatio = True
.Height = PicHght
PicWdth = .Width
Set Rng = .Range
End With
With Rng
If .Characters.Last.Next.Text = vbCr Then .Characters.Last.Next.Text = vbNullString
.InlineShapes(1).Range.Cut
End With
BShp = False: VRel = 0: HRel = 0: VPos = 0: HPos = 0
Call MakeImageTable(Rng, PicWdth, PicHght, BShp, VRel, HRel, VPos, HPos)
End If
Next
While .Shapes.Count > 0
BShp = True
With .Shapes(1)
.LockAspectRatio = True
.Height = PicHght
PicWdth = .Width
VRel = .RelativeVerticalPosition
HRel = .RelativeHorizontalPosition
VPos = .Top
HPos = .Left
Set iShp = .ConvertToInlineShape
End With
With iShp
Set Rng = .Range
.Range.Cut
End With
Call MakeImageTable(Rng, PicWdth, PicHght, BShp, VRel, HRel, VPos, HPos)
Wend
End With
End Sub
Sub MakeImageTable(Rng As Range, PicWdth As Single, PicHght As Single, BShp As Boolean, _
VRel As Long, HRel As Long, VPos As Single, HPos As Single)
Dim Tbl As Table, sngScl As Single, iShp As InlineShape
'Create & format the table
Set Tbl = Rng.Tables.Add(Range:=Rng, Numrows:=1, NumColumns:=1)
With Tbl
.Borders.Enable = True
.Columns.Width = PicWdth
.TopPadding = 0
.BottomPadding = 0
.LeftPadding = 0
.RightPadding = 0
.Spacing = 0
.Rows(1).HeightRule = wdRowHeightExactly
.Rows(1).Height = PicHght
With .Rows
.LeftIndent = 0
If BShp = True Then
.WrapAroundText = True
.HorizontalPosition = HPos
.RelativeHorizontalPosition = HRel
.VerticalPosition = VPos
.RelativeVerticalPosition = VRel
.AllowOverlap = False
End If
End With
With .Cell(1, 1).Range
With .ParagraphFormat
.SpaceBefore = 0
.SpaceAfter = 0
.LeftIndent = 0
.RightIndent = 0
.FirstLineIndent = 0
.KeepWithNext = True
End With
.Paste
End With
End With
End Sub
As coded, the macro will reformat all extra-table images in the document. To work with just the selected image (or multiple images in a selected range), change:
With ActiveDocument
to:
With Selection
and change:
While .Shapes.Count > 0
With .Shapes(1)
to:
While .ShapeRange.Count > 0
With .ShapeRange(1)