Consulting

Results 1 to 9 of 9

Thread: Add Pictures to Table

  1. #1
    VBAX Newbie
    Joined
    Apr 2020
    Posts
    4
    Location

    Post Add Pictures to Table

    Hello all,

    In the AddPics macro in http://www.vbaexpress.com/forum/show...l=1#post400370 is there a way to insert a page break so that there are 4 pics with captions per page?

    I'm trying to input about 100 graphs but can only have 4 per page in a 2x2 table. I tried adjusting the spacing but the caption row for images 5 and 6 would always appear on the first page instead of the second page
    graph test.jpg
    Last edited by macropod; 04-03-2020 at 04:08 PM. Reason: Split to new thread

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Simply add the 'keep with next' paragraph format to the Caption Style
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    VBAX Newbie
    Joined
    Apr 2020
    Posts
    4
    Location
    Thank you for the reply, that did not seem to work. Could it be because I have the captions above the images?

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    That suggets you may have content other than just the caption in the caption rows.

    Without actually seeing the problem document, however, it can be difficult for anyone to diagnose the issue. Can you attach a document to a post with some representative data (delete anything sensitive)? You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    VBAX Newbie
    Joined
    Apr 2020
    Posts
    4
    Location
    A document is attached, and this is the macro I'm using. Greatly appreciate the assistance

    Sub AddPics2()
    Application.ScreenUpdating = False
    Dim i As Long, j As Long, c As Long, r As Long, NumCols As Long, iShp As InlineShape
    Dim oTbl As Table, TblWdth As Single, StrTxt As String, RwHght As Single, ColWdth As Single
    On Error GoTo ErrExit
    NumCols = CLng(InputBox("How Many Columns per Row?"))
    RwHght = CentimetersToPoints(CSng(InputBox("What max height for the pictures, in centimeters (e.g. 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
        'Create a paragraph Style with 0 space before/after & centre-aligned
        On Error Resume Next
        With ActiveDocument
          .Styles.Add Name:="TblPic", Type:=wdStyleTypeParagraph
          On Error GoTo 0
          With .Styles("TblPic").ParagraphFormat
            .Alignment = wdAlignParagraphCenter
            .KeepWithNext = True
            .SpaceAfter = 0
            .SpaceBefore = 0
          End With
        End With
        '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
          ColWdth = TblWdth / NumCols
        End With
        With oTbl
          .AutoFitBehavior (wdAutoFitFixed)
          .Columns.Width = ColWdth
        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 FormatRows2(oTbl, r, RwHght)
          For c = 1 To NumCols
            j = j + 1
            'Insert the Picture
            Set iShp = ActiveDocument.InlineShapes.AddPicture( _
              FileName:=.SelectedItems(j), LinkToFile:=False, _
              SaveWithDocument:=True, Range:=oTbl.Cell(r + 1, c).Range)
            With iShp
              .LockAspectRatio = True
              If (.Width < ColWdth) And (.Height < RwHght) Then
                .Width = ColWdth
                If .Height > RwHght Then .Height = RwHght
              End If
            End With
            '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 above the picture
            With oTbl.Cell(r, 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 FormatRows2(oTbl As Table, x As Long, Hght As Single)
    With oTbl
      With .Rows(x)
        .Height = CentimetersToPoints(0.5)
        .HeightRule = wdRowHeightExactly
        .Range.Style = "Caption"
      End With
      With .Rows(x + 1)
        .Height = Hght
        .HeightRule = wdRowHeightExactly
        .Range.Style = "TblPic"
        .Cells.VerticalAlignment = wdCellAlignVerticalCenter
        
      End With
    End With
    End Sub

    graph test.docx

  6. #6
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    The problem is that the cell containing the pics also has the 'keep with next' property set. Change:
    .KeepWithNext = True
    to:
    .KeepWithNext = False
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  7. #7
    VBAX Newbie
    Joined
    Apr 2020
    Posts
    4
    Location
    Yes that worked. Thanks so much Paul!

  8. #8
    Quote Originally Posted by macropod View Post
    The problem is that the cell containing the pics also has the 'keep with next' property set. Change:
    .KeepWithNext = True
    to:
    .KeepWithNext = False
    Thank you very much, this is what I also need. I am using your macro for adding picture into a table word. It's very useful for me but when I select the picture file from msoFileDialogFilePicker, the selected files are auto sorted alphabetically (or algorithm) in the string array therefore the pictures inserted into word table as that order. But I want the pictures added as the order when I select them from the filepicker dialog one by one. Could you show me how to get this by change the macro or show me where I was wrong in using.

    P/s: I did not see where to start a new thread (and you did not accept private message also) so I reply to this thread to ask for your help

  9. #9
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    You can start a new thread by using the [+ Post New Thread] button

    Capture.JPG


    You should take a few minutes to look at the FAQ

    http://www.vbaexpress.com/forum/faq.php


    Especially

    http://www.vbaexpress.com/forum/faq....aq_req_help_pm

    http://www.vbaexpress.com/forum/faq...._new_faq_item3
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

Posting Permissions

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