Insert a new row at the top of each table using VBA

Hi Andreas, I think this will do it
Sub AddRow()
    Dim tbl As Table
   
    For Each tbl In ActiveDocument.Tables
        tbl.Rows.Add tbl.Rows.First
        tbl.Cell(1, 2).Range.InlineShapes.AddPicture "C:\MyPictures\MyGraphic.png", False, True
    Next
End Sub

Oops, should have refreshed before posting.

ok, great both codes work just fine. Thank you very much for it, great job.

Graham's code is a more 'elegant' since it does not use selection.

There is one more thing I would like to get added to this code.

The inserted graphic should get its aspect ratio locked and then resized to 4 cm

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Okay, I got the resizing done on Rgonzo codes, but I can't get it done on Graham's code.


Sub MacroInsertPictureResize()

Dim sFileName As String
Dim ilImage As InlineShape

sFileName = "C:\MyPictures\MyGraphic.jpg"
For Each tbl In ActiveDocument.Tables
    tbl.Rows(1).Select
    Selection.InsertRowsAbove 1
    tbl.Cell(1, 1).Select
    Selection.MoveRight Unit:=wdCell, Count:=1
    Set ilImage = Selection.InlineShapes.AddPicture(sFileName, False, True)
    With ilImage
    .LockAspectRatio = msoTrue
    .Width = CentimetersToPoints(4)
    End With
Next
End Sub

Since both codes work I think it is fair to award points to both of you.

Thank you very, very much for your swift and professional support. I really appreciate it.

Regards, Andreas