Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #7  
Old 09-05-2022, 03:41 PM
macropod's Avatar
macropod macropod is offline Macro to insert multiple images into a table with defined number of rows and columns Windows 10 Macro to insert multiple images into a table with defined number of rows and columns Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,523
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

The following variation on the macro from the linked thread shows how you might achieve what you're after. As coded, it uses fixed 2cm column widths and 1.5cm row heights. Transparencies are also set.
Code:
Sub AddPicsNoCaption()
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 = 7
RwHght = CentimetersToPoints(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
    '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 1-row by NumCols-column table to take the images
    Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=1, NumColumns:=NumCols)
    With ActiveDocument.PageSetup
      TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
      ColWdth = CentimetersToPoints(2)
    End With
    With oTbl
      .AutoFitBehavior (wdAutoFitFixed)
      .TopPadding = 0
      .BottomPadding = 0
      .LeftPadding = 0
      .RightPadding = 0
      .Spacing = 0
      .Columns.Width = ColWdth
      .Rows.Height = RwHght
      .Rows.HeightRule = wdRowHeightExactly
      .Range.Style = "TblPic"
      .Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
      .Borders.Enable = True
    End With
    For i = 1 To .SelectedItems.Count Step NumCols
      r = ((i - 1) / NumCols + 1) * 2 - 1
      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, c).Range)
        With iShp
          .PictureFormat.TransparentBackground = True
          .PictureFormat.TransparencyColor = wdColorWhite
          .Fill.Visible = False
          .LockAspectRatio = True
          If (.Width < ColWdth) And (.Height < RwHght) Then
            .Width = ColWdth
            If .Height > RwHght Then .Height = RwHght
          End If
        End With
        If j = .SelectedItems.Count Then Exit For
      Next
      'Add extra rows as needed
      If j < .SelectedItems.Count Then
        oTbl.Rows.Add
      End If
    Next
    With oTbl
      .Columns.Add .Columns(1)
      .Columns(1).PreferredWidth = CentimetersToPoints(2)
      .Rows.Alignment = wdAlignRowCenter
    End With
  End If
End With
ErrExit:
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro to insert multiple images into a table with defined number of rows and columns Macro to insert multiple images into a table Penini Word VBA 1 03-23-2022 02:30 PM
Macro type check columns of multiple tables - return mismatch rows zizz Excel Programming 3 08-28-2021 09:26 PM
Design macro insert number table rows simons Word VBA 7 09-20-2019 12:05 AM
Macro to insert multiple images into a table with defined number of rows and columns Insert multiple images in table with filename in column to the side Kass Word VBA 2 05-03-2018 08:14 AM
Using macro to add variable number of rows to a protected word table Julia Word Tables 1 01-09-2013 06:04 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 09:50 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft