Consulting

Results 1 to 3 of 3

Thread: Insert images in a specific row in a word table

  1. #1
    VBAX Newbie
    Joined
    Feb 2017
    Posts
    2
    Location

    Insert images in a specific row in a word table

    Hello!

    I am new in word vba and I need some help to do my first code.

    I have a table in word 2010, with three columns and I need to insert images from a windows folder in the third column of all rows, one image per row. The first row is the header row. In the first and second column there are information about the images, this is why I need the image in the third column.

    I would like to be able to choose the folder in which the images are and from here, the code will automatically insert the images in the third column of all the rows of the table in the same order that the images are in the windows folder.

    I need to resize the image according to the cell dimensions. With fixed cell dimensions.

    Could this be possible?

    Thanks in advance.

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,335
    Location
    This is crude but should get you started.

    Sub InsertImages()
    Dim lngCount As Long, oTbl As Table, oCell As Cell
    Dim oRng As Range, oILS As InlineShape
    Dim strFolder As String, strFile As String
     Application.ScreenUpdating = False
     strFolder = GetFolder
     If strFolder = "" Then Exit Sub
     Set oTbl = ActiveDocument.Tables(1)
     oTbl.AutoFitBehavior (wdAutoFitFixed)
     strFile = Dir(strFolder & "\*.*", vbNormal)
       While strFile <> ""
         If InStr(strFile, "jpg") > 0 Or InStr(strFile, "png") > 0 Then 'To filter only jpg and png graphic files
           lngCount = lngCount + 1
           If lngCount > oTbl.Rows.Count - 1 Then oTbl.Rows.Add
           Set oCell = oTbl.Cell(lngCount + 1, 3)
           Set oRng = oCell.Range
           oRng.Collapse wdCollapseStart
           Set oILS = oRng.InlineShapes.AddPicture(FileName:=strFolder & Application.PathSeparator & strFile, _
                      LinkToFile:=False, SaveWithDocument:=True)
           With oILS
             'Manipulate to suit
           End With
         End If
         strFile = Dir()
       Wend
       Application.ScreenUpdating = True
    lbl_Exit:
      Exit Sub
    End Sub
    
    Function GetFolder() As String
    Dim oFolder As Object
      GetFolder = ""
      Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
      If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
      Set oFolder = Nothing
    End Function
    But to really get started, you have to write some code.

    Sub Help()
    Msgbox "What do I next"
    End Sub

    Is better than nothing ;-)
    Greg

    Visit my website: http://gregmaxey.com

  3. #3
    VBAX Newbie
    Joined
    Feb 2017
    Posts
    2
    Location
    Thank you so much, it works fine!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •