Consulting

Results 1 to 19 of 19

Thread: Inserting multiple images into Word Table

  1. #1
    VBAX Regular
    Joined
    Jun 2019
    Location
    London
    Posts
    10
    Location

    Inserting multiple images into Word Table

    Hi all,

    Please be gentle with me as I haven't coded since DOS 6.2, and VBA is a bit of a dark art...

    In another thread, a gentleman called Paul, posting as Macropod, put this fantastic piece of code up:

    Sub AddPics() Application.ScreenUpdating = False Dim i As Long, j As Long, c As Long, r As Long, NumCols As Long Dim oTbl As Table, TblWdth As Single, StrTxt As String, RwHght As Single On Error GoTo ErrExit NumCols = CLng(InputBox("How Many Columns per Row?")) RwHght = CSng(InputBox("What row height for the pictures, in inches (e.g. 1.5)?")) On Error GoTo 0 'Select and insert the Pics With Application.FileDialog(msoFileDialogFilePicker) .Title = "Select image files and click OK" .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png" .FilterIndex = 2 If .Show = -1 Then 'Add a 2-row by NumCols-column table to take the images Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols) With ActiveDocument.PageSetup TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter End With With oTbl .AutoFitBehavior (wdAutoFitFixed) .Columns.Width = TblWdth / NumCols End With CaptionLabels.Add Name:="Picture" For i = 1 To .SelectedItems.Count Step NumCols r = ((i - 1) / NumCols + 1) * 2 - 1 'Format the rows Call FormatRows(oTbl, r, RwHght) For c = 1 To NumCols j = j + 1 'Insert the Picture ActiveDocument.InlineShapes.AddPicture _ FileName:=.SelectedItems(j), LinkToFile:=False, _ SaveWithDocument:=True, Range:=oTbl.Cell(r, c).Range 'Get the Image name for the Caption StrTxt = Split(.SelectedItems(j), "\")(UBound(Split(.SelectedItems(j), "\"))) StrTxt = ": " & Split(StrTxt, ".")(0) 'Insert the Caption on the row below the picture With oTbl.Cell(r + 1, c).Range .InsertBefore vbCr .Characters.First.InsertCaption _ Label:="Picture", Title:=StrTxt, _ Position:=wdCaptionPositionBelow, ExcludeLabel:=False .Characters.First = vbNullString .Characters.Last.Previous = vbNullString End With 'Exit when we're done If j = .SelectedItems.Count Then Exit For Next 'Add extra rows as needed If j < .SelectedItems.Count Then oTbl.Rows.Add oTbl.Rows.Add End If Next Else End If End With ErrExit: Application.ScreenUpdating = True End Sub ' Sub FormatRows(oTbl As Table, x As Long, Hght As Single) With oTbl With .Rows(x) .Height = InchesToPoints(Hght) .HeightRule = wdRowHeightExactly .Range.Style = "Normal" End With With .Rows(x + 1) .Height = CentimetersToPoints(0.5) .HeightRule = wdRowHeightExactly .Range.Style = "Caption" End With End With End Sub
    I am trying to amend this for my own purposes with less than stellar success, so am looking for guidance as, to be honest, I don't really understand what I'm doing yet.

    I need:-
    • 3 columns
    • About 10pt padding all round the image
    • No caption row
    • 1pt black border around each cell
    • Images centred horizontally and vertically in each cell


    Page is A4 portrait with standard margins.

    Any advice you can give would be hugely appreciated.

    Thanks,

    Simon

  2. #2
    VBAX Regular
    Joined
    Jun 2019
    Location
    London
    Posts
    10
    Location
    This is the thread I found the code...

    http://www.vbaexpress.com/forum/show...ord-With-Macro

    Can't post it as a URL as I'm still new, sorry.

    Thanks,

    Simon

  3. #3
    Paul may be along later to assist with his code. In the meantime see https://www.gmayor.com/photo_gallery_template.html
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,874
    Location
    Try:
    Sub AddPics()
        Application.ScreenUpdating = False
        Dim i As Long, NumCols As Long
        Dim oTbl As Table, TblWdth As Single, StrTxt As String, RwHght As Single
        On Error GoTo ErrExit
        NumCols = 3
        RwHght = CSng(InputBox("What row height for the pictures, in inches (e.g. 1.5)?"))
        On Error GoTo 0
        'Select and insert the Pics
        With Application.FileDialog(msoFileDialogFilePicker)
            .Title = "Select image files and click OK"
            .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png"
            .FilterIndex = 2
            If .Show = -1 Then
                'Add a 3-column table to take the images
                Set oTbl = Selection.Tables.Add(Range:=Selection.Range, _
                  NumRows:=-Int(-.SelectedItems.Count / 3), NumColumns:=NumCols)
                With ActiveDocument.PageSetup
                  TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
                End With
                'Define the table layout
                With oTbl
                    .AutoFitBehavior (wdAutoFitFixed)
                    .Columns.Width = TblWdth / NumCols
                    .Range.Style = "Normal"
                    .TopPadding = 10
                    .BottomPadding = 10
                    .LeftPadding = 10
                    .RightPadding = 10
                    .Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
                    With .Range.ParagraphFormat
                      .Alignment = wdAlignParagraphCenter
                      .SpaceBefore = 0
                      .SpaceAfter = 0
                    End With
                    With .Borders
                      .Enable = True
                      .InsideLineStyle = wdLineStyleSingle
                      .InsideLineWidth = wdLineWidth100pt
                    End With
                    With .Rows
                      .Height = InchesToPoints(RwHght)
                      .HeightRule = wdRowHeightExactly
                    End With
                End With
                For i = 1 To .SelectedItems.Count
                  'Insert the Picture
                  ActiveDocument.InlineShapes.AddPicture _
                    FileName:=.SelectedItems(i), LinkToFile:=False, _
                    SaveWithDocument:=True, Range:=oTbl.Range.Cells(i).Range
                Next
            Else
            End If
        End With
    ErrExit:
        Application.ScreenUpdating = True
    End Sub
    Cheers
    Paul Edstein
    [MS MVP - Word]

  5. #5
    VBAX Regular
    Joined
    Jun 2019
    Location
    London
    Posts
    10
    Location
    Graham, thank you - I already tried that and it was so close to what I needed.

    Paul, you sir are a godsend. Thank you.

    If either of you gentlemen happen to be in the UK at any time, let me know first and the first beer is on me.

  6. #6
    VBAX Regular
    Joined
    Jun 2019
    Location
    London
    Posts
    10
    Location
    However...

    While it works brilliantly on a blank page, if I try to run the macro where there are any other tables (and that's kinda important as the images are in an inventory - there's a table of words describing the contents of a room, then a table of pictures, then a table of words etc) I get a run-time error as follows:

    Run-Time Error '5149':

    The measurement must be between 0 pt and 1584 pt.

    Then when I go to debug, the following line is highlighted: (my bold)

      'Define the table layout
                With oTbl
                    .AutoFitBehavior (wdAutoFitFixed)
                    .Columns.Width = TblWdth / NumCols
                    .Range.Style = "Normal"  'Define the table layout
                With oTbl
                    .AutoFitBehavior (wdAutoFitFixed)
                    .Columns.Width = TblWdth / NumCols
                    .Range.Style = "Normal"
    Any suggestions, please?

    Oh, I changed the cell padding to 5 all round but it made no difference to the error.

    Thanks,

    SB

  7. #7
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,874
    Location
    At first glance, I'd say that's because where you're insterting the table is causing Word to attach it to a preceding or following table - or even within an existing table. Make sure there's at least one paragraph break either side of where you're trying to insert the table.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  8. #8
    VBAX Regular
    Joined
    Jun 2019
    Location
    London
    Posts
    10
    Location
    I'd be inclined to agree with you, except looking at the document in outline view I get this (after adding breaks because that made sense)


    You can see the empty table left by the macro after I closed the debug dialogue.



    Attachment 24496

    I know there are limitations on what I can include as a newbie, but if there's anything more useful I can provide to help diagnose what's going on then please say...

    PC is running Win 10/64 and as I think I said before, paper size is A4.

    Thanks,

    Simon

  9. #9
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,874
    Location
    Your attachment is invalid, so it's impossible to know what you mean.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  10. #10
    Quote Originally Posted by Darth Gixxer View Post
    Graham, thank you - I already tried that and it was so close to what I needed.
    The only thing that is missing from the add-in, to produce your image layout, is the ability to set the table margins, but it is easy enough to add that option to the add-in if you think it would be useful.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    VBAX Regular
    Joined
    Jun 2019
    Location
    London
    Posts
    10
    Location
    Quote Originally Posted by macropod View Post
    Your attachment is invalid, so it's impossible to know what you mean.
    That's weird - it was working fine when I posted...

    Trying again now:

    Capture.jpg

  12. #12
    VBAX Regular
    Joined
    Jun 2019
    Location
    London
    Posts
    10
    Location
    Quote Originally Posted by gmayor View Post
    The only thing that is missing from the add-in, to produce your image layout, is the ability to set the table margins, but it is easy enough to add that option to the add-in if you think it would be useful.
    Graham, if that's a possibility then it would be a wonderful thing...

  13. #13
    Contact me via my web site and refer to this thread,
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  14. #14
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,874
    Location
    Quote Originally Posted by Darth Gixxer View Post
    Trying again now
    I am unable to reproduce the error in an empty Section, but those small circles going the full height of your screenshot suggest the Section might already contain some content (perhaps another table) that's conflicting with the macro.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  15. #15
    VBAX Regular
    Joined
    Jun 2019
    Location
    London
    Posts
    10
    Location
    Chaps, really appreciate your help on this.

    I'm attaching a link to a cut-down version of the type of document I'm trying to work with in case it sheds any light. You can see it looks pretty crappy at the moment, even ignoring that the spacing is now all wrong because I've taken lumps out... I've left the first and last pages though as they may, I guess, have some bearing in the format...

    I am away on deployment for three weeks from Friday so won't have a chance to reply to anything before I get back, probably.

    Here's the link: https://www.dropbox.com/s/2kp2cs5jpd...moDoc.doc?dl=0

    Again, I really appreciate your efforts. And Graham, I'll give you a shout when I get back if we're still stuck.

    Cheers,

    Simon

  16. #16
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,874
    Location
    Your document seems to have some kind of corruption that results in one or more margins being undefined in VBA, and that's what's causing the problem. Since the usual method of copy everything except the last para break & pasting the copied content into a new document doesn't resolve the issue, it looks like you might need to recreate it from scratch.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  17. #17
    Quote Originally Posted by Darth Gixxer View Post
    Graham, if that's a possibility then it would be a wonderful thing...
    I have now added the ability to change the margins to the add-in https://www.gmayor.com/photo_gallery_template.html
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  18. #18
    VBAX Regular
    Joined
    Jun 2019
    Location
    London
    Posts
    10
    Location
    Paul and Graham, you are both the types of folk that made The Internet such a useful and wonderful thing.

    You're also bloody good at VB.

    Back in the UK and trying both options to see which does it for me.

    Thanks guys.

    Simon

  19. #19
    VBAX Regular
    Joined
    Jun 2019
    Location
    London
    Posts
    10
    Location
    Paul, your script works perfectly for me to build image galleries as standalone items, but unfortunately if I try to embed it in the inventory, even with a completely new template started from scratch, it errors. I suspect this is because I'm putting the gallery between other tables, and no matter how ferocious the breaks I put (paragraph, page, section) it still gets confused.

    Doesn't alter the fact that you've helped loads and I owe you a beer though, so let me know next time you make that long trip and it's on me...

    Graham, I believe you've cracked it, sir. Messaged you through your site with some other questions, but I think we're there.

    Thank you, and obviously the same beer offer applies.

    Simon

Posting Permissions

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