Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 12-24-2020, 12:30 AM
victorybadges victorybadges is offline Create Table for Multiple Pictures Windows 10 Create Table for Multiple Pictures Office 2013
Novice
Create Table for Multiple Pictures
 
Join Date: Dec 2020
Posts: 22
victorybadges is on a distinguished road
Default Create Table for Multiple Pictures

Dear macropod

I literally stumbled onto the brilliant AddPics macro in https://www.msofficeforums.com/word-...es-1-page.html. I was actually searching for ways of doing this. It will save me so much time. Thank you. My question is can you advise on how to run it without captions please. thank you



Edit: just to clarify, I don't want a caption line either, simply a table full of photos as I have 400 photos and the images do not require a caption.

Last edited by victorybadges; 12-24-2020 at 03:19 PM. Reason: additional clarification
Reply With Quote
  #2  
Old 12-24-2020, 11:54 PM
macropod's Avatar
macropod macropod is offline Create Table for Multiple Pictures Windows 10 Create Table for Multiple Pictures Office 2010
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
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 code for that is quite different:
Code:
Sub AddPicsNoCaption()
Application.ScreenUpdating = False
Dim Stl As Style, 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
    With ActiveDocument
      On Error Resume Next
      Set Stl = .Styles("TblPic")
      If Stl Is Nothing Then Set Stl = .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 = TblWdth / NumCols
    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
          .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
  Else
  End If
End With
ErrExit:
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #3  
Old 12-25-2020, 01:20 PM
victorybadges victorybadges is offline Create Table for Multiple Pictures Windows 10 Create Table for Multiple Pictures Office 2013
Novice
Create Table for Multiple Pictures
 
Join Date: Dec 2020
Posts: 22
victorybadges is on a distinguished road
Default

Merry Xmas Macropod, this is the best Xmas present, much appreciated.
I have tested the macro and it works wonderfully except for 1 thing which can be fixed manually. The images are not centred as the cell margins are not set to zero. (PS I used fixed width columns)

As I use varying fixed column widths in different tables is there a way of enabling a fixed width question to be prompted on run time to save me from editing the macro each time. thank you kindly

many thanks
Reply With Quote
  #4  
Old 12-25-2020, 01:54 PM
macropod's Avatar
macropod macropod is offline Create Table for Multiple Pictures Windows 10 Create Table for Multiple Pictures Office 2010
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
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

Quote:
Originally Posted by victorybadges View Post
I have tested the macro and it works wonderfully except for 1 thing which can be fixed manually. The images are not centred as the cell margins are not set to zero. (PS I used fixed width columns)
Unless you have some default set up with different left/right and/or top/bottom margins, the images cannot but be centered in the cells. nevertheless, I've added code to eliminate all cell margins.
Quote:
Originally Posted by victorybadges View Post
As I use varying fixed column widths in different tables is there a way of enabling a fixed width question to be prompted on run time to save me from editing the macro each time.
After:
Code:
RwHght = CentimetersToPoints(CSng(InputBox("What max height for the pictures, in Centimeters (e.g. 5)?")))
insert:
Code:
ColWdth = CentimetersToPoints(CSng(InputBox("What max column width for the pictures, in Centimeters (e.g. 8)?")))
and either delete:
Code:
ColWdth = TblWdth / NumCols
or change that line to:
Code:
If TblWdth / NumCols < ColWdth Then ColWdth = TblWdth / NumCols
Delete the line if you don't care whether the cumulative specified column width exceeds the page margins; otherwise, make the change.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #5  
Old 12-25-2020, 02:11 PM
victorybadges victorybadges is offline Create Table for Multiple Pictures Windows 10 Create Table for Multiple Pictures Office 2013
Novice
Create Table for Multiple Pictures
 
Join Date: Dec 2020
Posts: 22
victorybadges is on a distinguished road
Default

thanks Paul, I will give it a go later today. Much appreciated.
I will also amend the original macro as I will need captions in some of my tables.
I am writing a book with pages of images and this will be very handy
cheers
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
How do I change multiple pictures in Word 2016 to all new pictures that appear in a specified order? chaz Word VBA 7 07-11-2018 03:57 AM
Create Table for Multiple Pictures Mail merge from excel - need to create sheets and create a table bluenosebex Mail Merge 5 08-02-2015 05:34 PM
Create multiple copies of same email in multiple folders gaker10 Outlook 0 10-06-2014 07:44 AM
create fields with multiple lines - fix column width in table expert4knowledge Word 4 02-14-2014 01:06 PM
Create Table for Multiple Pictures Resize multiple pictures in a Word 2010 table JBA479 Word VBA 1 01-24-2014 08:51 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 12:45 PM.


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