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

Dear Experts:

I would like to run a macro that performs the following actions:

Insert a new row into all tables of the current document
Insert a graphic into the second cell of this newly added 'header' row
The graphic is located in: C:\MyPictures\MyGraphic.png

Help is much appreciated.

Thank you very much in advance.

Regards, Andreas
Andreas HermleTeam leaderAsked:
Who is Participating?
 
GrahamSkanRetiredCommented:
The code is very similar to what you did with Rgonzo's version:
Sub AddRow()
    Dim tbl As Table
    Dim ilsh As InlineShape
    
    For Each tbl In ActiveDocument.Tables
        tbl.Rows.Add tbl.Rows.First
        'Set ilsh = tbl.Cell(1, 2).Range.InlineShapes.AddPicture("C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum.jpg", False, True)
        Set ilsh = tbl.Cell(1, 2).Range.InlineShapes.AddPicture("C:\MyPictures\MyGraphic.png", False, True)
        ilsh.LockAspectRatio = True
        ilsh.Width = CentimetersToPoints(4)
    Next
End Sub

Open in new window

0
 
Rgonzo1971Commented:
Hi,

pls try

Sub Macro()

For Each tbl In ActiveDocument.Tables
    tbl.Rows(1).Select
    Selection.InsertRowsAbove 1
    tbl.Cell(1, 1).Select
    Selection.MoveRight Unit:=wdCell, Count:=1
    Selection.InlineShapes.AddPicture FileName:= _
        "C:\MyPictures\MyGraphic.png", LinkToFile:=False, _
        SaveWithDocument:=True
Next
End Sub

Open in new window

Regards
0
 
GrahamSkanRetiredCommented:
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
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
GrahamSkanRetiredCommented:
Oops, should have refreshed before posting.
0
 
Andreas HermleTeam leaderAuthor Commented:
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
0
 
Andreas HermleTeam leaderAuthor Commented:
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
0
 
Andreas HermleTeam leaderAuthor Commented:
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
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.