Shapes.AddPicture in Word Table

Question

I am using a Word table as a placeholder for images, where table cells contain only pictures and no text.

When inserting a picture into a Word table, I have no problems when inserting an Inline Shape. The picture appears into the expected cell. However, with the "equivalent" code which inserts the picture as a Shape, the shape does not always appear in the expected cell. So far, I have seen this problem in Word 2013, 32 bit version.

Sub test()
    Dim s As Shape
    Dim x As String
    Dim f As String
    Dim r As Long
    Dim c As Long
    Dim h As Single
    Dim w As Single
    Dim rng As Word.Range
    Dim ins As Word.InlineShape

    f = "file name of a picture, .bmp .jpg etc."

    Word.Application.ScreenUpdating = False

    If Selection.Information(wdWithInTable) Then
        ' insert a picture in a table cell
        r = Selection.Information(wdStartOfRangeRowNumber)
        c = Selection.Information(wdStartOfRangeColumnNumber)

        With Selection.Tables(1).Cell(r, c)
            Set rng = .Range
            rng.collapse wdCollapseStart
            .Range.Text = ""
            h = .height
            w = .width
        End With

        ' Works reliably
        Set s = Word.Selection.InlineShapes.AddPicture(f, False, True, rng).ConvertToShape
        s.height = h
        s.width = w

        ' Not at all reliable
        ' Set s = Word.ActiveDocument.Shapes.AddPicture(f, False, True, 0, 0, w, h, rng)

    Else
        ' insert a picture at the cursor
        h = 100
        w = 100
        Set s = Word.ActiveDocument.Shapes.AddPicture(f, False, True, 0, 0, w, h)
    End If

    Word.Application.ScreenUpdating = True

    s.WrapFormat.Type = wdWrapInline
    s.Title = "Title"
    s.AlternativeText = "Some metadata"
End Sub

The idea is to select either a cell in a table in a document or somewhere on the page outside of the table. The outside of the table case works as expected where the picture appears at the cursor location.

To see the problem, start with a fresh document, single page, add a 3 x 3 table and deepen the rows a bit. Be sure to supply a file to insert, variable f. Select one of the cells, then run the code. This works correctly when the picture is inserted as an inline shape then immediately converted to a shape. That happens with this line:

Set s = Word.Selection.InlineShapes.AddPicture(f, False, True, rng).ConvertToShape

However, the preferred solution would be to insert a Shape from the beginning with code something like this:

Set s = Word.ActiveDocument.Shapes.AddPicture(f, False, True, 0, 0, w, h, rng)

The picture appears, but usually not in the expected location. It could be placed into a different cell or somewhere outside the table.

Is the rng argument to Shapes.AddPicture being ignored or mangled somehow?

Experimenting some more with the 3 x 3 table - adding pictures then setting every possible WrapFormat.Type (there are 8 possible values), I see that:

• for every WrapFormat.Type except wdWrapInLine, picture insertion works correctly as long as they are done from left to right on a table row, and;
• for every WrapFormat.Type without exception, when the row is initially empty, pictures inserted in columns 2 or 3 appear one column to the left.

Making the picture smaller, such as setting h = .height * 0.5 and w = .width * 0.5, has no effect on placement.

Thanks very much for any insight or elucidation.

Answer 1

The main problem appears to be about the pictures inserting in the wrong column. This would be because the "focus point" (location of the Range) of an empty table cell has its starting point in the previous cell. Doesn't really make a lot of sense, but that's how Word works...

Try collapsing the Range to the End, rather than the Start (wdCollapseEnd) in this extract from your code:

    With Selection.Tables(1).Cell(r, c)
        Set rng = .Range
        rng.collapse wdCollapseEnd 'instead of wdCollapseStart
        .Range.Text = ""
        h = .height
        w = .width
    End With

Answer 2

In the end, selective usage of rng.collapse did the trick. I have yet to check whether this behaviour is the same in Word 2010 or 2016.

For the first shape anywhere in a table row, rng.collapse wdCollapseEnd.

For all subsequent shapes on that table row, rng.collapse wdCollapseBegin.

I used the following code to count up the shapes in table rows:

Dim numShapes() As Integer
Dim cel As Word.cell

ReDim numShapes(1 To Selection.Tables(1).Rows.Count)
For Each cel In Selection.Tables(1).Range.Cells
    If cel.Range.ShapeRange.Count <> 0 Then
        numShapes(cel.RowIndex) = numShapes(cel.RowIndex) + 1
    End If
Next cel

and the check is simply

If numShapes(r) <> 0 Then
    rng.collapse wdCollapseStart
Else
    rng.collapse wdCollapseEnd
End If

where r is the row number from the first code example.

Initial experiments with merged cells suggest other problems...