![]() |
|
|||||||
|
|
|
Thread Tools | Display Modes |
|
|
|
#1
|
|||
|
|||
|
I want to insert multiple images, without any captions, into a table with 6 columns and 16 rows. Each image should go into the next cell within a row (ie next column) and then at the end of the row go into first column in next row. (So 7th image would go into 2nd row first column) I see other VBAs doing something similar but not this exactly. |
|
#2
|
||||
|
||||
|
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#3
|
|||
|
|||
|
Quote:
Last edited by Davidl88; 09-04-2022 at 03:40 AM. |
|
#4
|
|||
|
|||
|
Can this script be modified so that there are seven columns but the first column is kept blank?
|
|
#5
|
|||
|
|||
|
I have a table - 16 rows and 6 columns. Each cell contains a variant on a picture of an object. I want to set transparent color for the background (which is white) for all these images at once rather than individually at a time. Is there a way to do this?
|
|
#6
|
||||
|
||||
|
Assuming you're using the code from https://www.msofficeforums.com/word-...-pictures.html, after:
With iShp insert: Code:
.PictureFormat.TransparentBackground = True .PictureFormat.TransparencyColor = wdColorWhite .Fill.Visible = False
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
#7
|
||||
|
||||
|
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] |
|
| Thread Tools | |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
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 |
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 |