#1
|
|||
|
|||
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 |
#2
|
||||
|
||||
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] |
#3
|
|||
|
|||
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 |
#4
|
||||
|
||||
Quote:
Quote:
Code:
RwHght = CentimetersToPoints(CSng(InputBox("What max height for the pictures, in Centimeters (e.g. 5)?"))) Code:
ColWdth = CentimetersToPoints(CSng(InputBox("What max column width for the pictures, in Centimeters (e.g. 8)?"))) Code:
ColWdth = TblWdth / NumCols Code:
If TblWdth / NumCols < ColWdth Then ColWdth = TblWdth / NumCols
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
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 |
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 |
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 |
Resize multiple pictures in a Word 2010 table | JBA479 | Word VBA | 1 | 01-24-2014 08:51 PM |