Word VBA Move Images and Text into a Table - vba

Question

I'm trying to check every section of a document for images or grouped images and, if they're found, create a table with 1 row and 2 columns at the beginning of that section, where the first column will contain the text (with original formatting) and the second column will contain the images. I have converted all the images in the document to inline shapes.
Edit: In the document, there's random amounts of text (and/or other characters) before, after and in between a random amount of images. Sometimes a section has no text and only images. For each section, I would like all of the text (with original formatting and in the order in which it occurs) to be contained in the first column, and all images and grouped images (also in their same order) to be contained in the second folder. Ideally, if the only things on the page are a heading and an image, they would be put into a 1x1 table (with the heading above the image).
I've tried a few variations of this with no success. Generally stuff starts getting pretty messy because I have no idea what I'm doing. I've left out the text in this code because it was only complicating things, but I would like to move the text as well.
Sub ToTables()
Dim iShp As InlineShape
Dim oRng As Range
Dim oTbl As Table
Dim i As Integer
Dim a As Integer
Dim b As Integer
a = ActiveDocument.BuiltInDocumentProperties("Number of Sections")
For i = 1 To a
Set oRng = ActiveDocument.GoTo(What:=wdGoToSection, Name:=i)
Set oRng = oRng.GoTo(What:=wdGoToBookmark, Name:="\section")
If Right(oRng, 1) = vbCr Then _
oRng = Left(oRng, Len(oRng) - 1)
b = oRng.InlineShapes.Count
If b >= 1 Then
oRng.Collapse Direction:=wdCollapseStart
Set oTbl = oRng.Tables.Add(oRng, 1, 2, AutoFitBehavior:=wdAutoFitContent)
For Each iShp In oRng.InlineShapes
iShp.Select
Selection.Cut
oTbl.Cell(1, 2).Range.Paste
Next iShp
End If
Next i
End Sub
Thanks

Answer 1

Try the revised code:
Sub Demo()
Application.ScreenUpdating = False
Dim Sctn As Section, Rng As Range, Tbl As Table, s As Long, w As Single
For Each Sctn In ActiveDocument.Sections
Set Rng = Sctn.Range: w = 0
Rng.End = Rng.End - 1
Set Tbl = Rng.ConvertToTable(, NumRows:=1, NumColumns:=1, InitialColumnWidth:=50, AutoFit:=True)
With Tbl
.Columns.Add
For s = .Range.InlineShapes.Count To 1 Step -1
With .Range.InlineShapes(s)
If .Width > w Then w = .Width
.Range.Rows(1).Cells(2).Range.FormattedText = .Range.FormattedText
.Delete
End With
Next
.Columns(1).Cells.Merge
.Columns(2).Cells.Merge
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
If w > 0 Then .Columns(2).Width = w + .LeftPadding + .RightPadding
.Rows.HeightRule = wdRowHeightAuto
End With
Next
Application.ScreenUpdating = True
End Sub

Answer 2

Assuming the text precedes the inlineshapes:
Sub Demo()
Application.ScreenUpdating = False
Dim iShp As InlineShape
For Each iShp In ActiveDocument.InlineShapes
With iShp.Range
.Characters.First.Previous = vbTab
.Start = .Paragraphs.First.Range.Start
.ConvertToTable vbTab, 1, 2
End With
Next
Application.ScreenUpdating = True
End Sub
The above code assumes there is a single character between the text & inlineshape. That character could be a space, paragraph break, line break, anything at all.