Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 04-28-2013, 01:12 PM
2whldreams 2whldreams is offline 4 digital images on 1 page Windows Vista 4 digital images on 1 page Office 2007
Novice
4 digital images on 1 page
 
Join Date: Apr 2013
Posts: 1
2whldreams is on a distinguished road
Default 4 digital images on 1 page

Greetings. Thank you in advance for viewing my question.

The goal is to take 4 digital images from my file and insert onto one page. Preferably with no border.

I can insert one image easy enough, but the second image defaults to a second page.

Supposedly the image can be moved about with a left drag of the mouse but my efforts result in no movement.
Reply With Quote
  #2  
Old 04-28-2013, 04:01 PM
macropod's Avatar
macropod macropod is offline 4 digital images on 1 page Windows 7 64bit 4 digital images on 1 page Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,453
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

The simplest way is to create a 4-cell table, with the 'automatically resize to fit contents' option 'off' and with the cell width and 'exact' height set to the maximum allowable for each image (eg, in a 2*2 table, the column width would be, say, half the intra-margin width and the row height would be half the intra-margin height). You can turn off the table's border display. With this setup, any image you insert into the table will be constrained so that it fits into the cell whilst maintaining the correct aspect ratio.

The following macro automates the insertion of multiple images into a table (which the macro also creates) in a Word document. As coded, it allows you to specify any number of columns and the picture row height. The column-width is calculated automatically, based on the page print width. Any inserted pictures will be constrained to fit the available cell space, at the correct aspect ratio, by enlarging/reducing them, as appropriate. Below each image is a row for adding a caption. The process begins at wherever the selection/insertion point is.

As coded, the macro uses the "Caption" Style for the caption rows. This left-aligns the captions. It also uses a custom "TblPic" Style for the image rows, ensuring the pictures are horizontally centred in their cells and correctly fill the space available. Cells are also centred vertically. You can change any of these parameters.
Code:
Sub AddPics()
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
      .Borders.Enable = True
    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 FormatRows(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, 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 below the picture
        With oTbl.Cell(r + 1, 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 FormatRows(oTbl As Table, x As Long, Hght As Single)
With oTbl
  With .Rows(x)
    .Height = Hght
    .HeightRule = wdRowHeightExactly
    .Range.Style = "TblPic"
    .Cells.VerticalAlignment = wdCellAlignVerticalCenter
  End With
  With .Rows(x + 1)
    .Height = CentimetersToPoints(0.5)
    .HeightRule = wdRowHeightExactly
    .Range.Style = "Caption"
  End With
End With
End Sub
If you want to use a fixed column-width, you could change:
.Columns.Width = TblWdth / NumCols
to, say:
.Columns.Width = CentimetersToPoints(7.5)
where '7.5' is the required width in cm (try not to use a column width & count that exceed your printable area!).

If you're concerned to prevent overly-long captions wrapping, you can:
1. Reduce the Caption Style's font size; and/or
2. Apply the 'Fit Text' option to long captions so they fit on one line. This might be accomplished by inserting:
Code:
          If .Characters.Last.Previous.Information(wdVerticalPositionRelativeToPage) <> _
            .Characters.First.Information(wdVerticalPositionRelativeToPage) Then
            .FitTextWidth = ColWdth
          End If
after:
Code:
          .Characters.Last.Previous = vbNullString
To insert the captions above the pictures you need to -
• Change:
.KeepWithNext = True
to:
.KeepWithNext = False
and insert:
.Styles("Caption").ParagraphFormat.KeepWithNext = True
after:
CaptionLabels.Add Name:="Picture"

• Change:
SaveWithDocument:=True, Range:=oTbl.Cell(r, c).Range
to:
SaveWithDocument:=True, Range:=oTbl.Cell(r + 1, c).Range

• Change:
With oTbl.Cell(r + 1, c).Range
to:
With oTbl.Cell(r, c).Range

• Swap:
With .Rows(x)
and:
With .Rows(x + 1)

If your situation is one in which the images may change from time to time, but you want to avoid replacing them manually each time, you could change:
LinkToFile:=False
to:
LinkToFile:=True
That way, the images will auto-update if you replace them with others of the same name.

For a borderless table
• Change:
.Borders.Enable = True
to:
.Borders.Enable = False

If you don't want the final result to be in a table, insert:
oTbl.ConvertToText
before:
Else

Finally, if you prefer to work in imperial units rather than metric units, change all
Centimeters
references to:
Inches

For PC macro installation & usage instructions, see: Installing Macros
For Mac macro installation & usage instructions, see: Word:mac - Install a Macro
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #3  
Old 11-08-2018, 05:08 AM
bomberboy bomberboy is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2016
Novice
 
Join Date: Nov 2018
Location: Australia
Posts: 1
bomberboy is on a distinguished road
Default

I have been looking for this code for so long.

This will literally save me hours and hours of work as I have over 300 photos to tabulate.
Reply With Quote
  #4  
Old 11-12-2018, 12:29 PM
Dorin38 Dorin38 is offline 4 digital images on 1 page Windows 7 64bit 4 digital images on 1 page Office 2010
Novice
 
Join Date: Nov 2018
Posts: 1
Dorin38 is on a distinguished road
Default Hello.

Hello everyone, thank you macropod for this macro it is very usefull for me at work. Do you think this macro can be improved, as to autocorrect the captions under the photos inserted if you delete one photo?
What i mean is that if i insert 4 photos and i delete photo 3, the captions under the remaining photos to be in order and photo 4 caption to be automatically deleted.
Reply With Quote
  #5  
Old 11-12-2018, 03:18 PM
macropod's Avatar
macropod macropod is offline 4 digital images on 1 page Windows 7 64bit 4 digital images on 1 page Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,453
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

Since the macro concerns only the insertion of images, not their deletion, the simple answer is: no.

However, if you were to use a multicolumn page layout for wherever you want the pics to appear, together with a specification that there should only be one image per column, deleting an image and its caption will result in all the others updating correctly with no blank cells. Do be aware, though, that this changes the layout from across-then-down to down-then-across.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #6  
Old 07-13-2020, 05:09 AM
Matt32258 Matt32258 is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2019
Novice
 
Join Date: Jul 2020
Posts: 1
Matt32258 is on a distinguished road
Default

Dear Macropod, thank you for the well thought out VBA code. Unfortunately I experienced and error when attempting to run the macro routine. I am hoping that someone might offer advice in diagnosis the cause of the error.
The error message is: Run-time error '4605':
This method or property is not available because this command is not available inside math.
The command line where this occurred:
Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols)

Thank you everyone. Cheers/M
Reply With Quote
  #7  
Old 07-13-2020, 04:05 PM
Guessed's Avatar
Guessed Guessed is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 1,732
Guessed is a glorious beacon of lightGuessed is a glorious beacon of lightGuessed is a glorious beacon of lightGuessed is a glorious beacon of lightGuessed is a glorious beacon of lightGuessed is a glorious beacon of light
Default

NumCols should be an Integer that you entered in an inputbox. It is defined as Long so conceivably you are not putting an Integer in as the input value.

What are you seeing if you hover over the word NumCols when that line is being debugged?
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote
  #8  
Old 07-14-2020, 02:54 PM
eduzs eduzs is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2019
Competent Performer
 
Join Date: May 2017
Posts: 208
eduzs is on a distinguished road
Default

Hi! Thanks!
There is a way to use the maximum available page area instead of asking for the maximum picture height? Considering a given number of rows and columns (pictures) per page.
__________________
Backup your original file before doing any modification.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Digital signatures hannu Word 0 11-18-2012 03:19 PM
Saving doc as "Web Page, Filtered" reduces some images' quality GregL Word 1 08-14-2012 03:27 AM
4 digital images on 1 page Images jumping from page to page... Colonel Biggs Drawing and Graphics 13 12-12-2011 08:52 PM
4 digital images on 1 page Mail Mege Images - Path Correct but Images Repeated Sonia Sosa Mail Merge 8 04-22-2011 03:05 PM
Inline Images Floating BEHIND Text & Off Page Pennimus Drawing and Graphics 0 02-22-2010 09:29 AM

Other Forums: Access Forums - Senior Forums

All times are GMT -7. The time now is 01:31 PM.


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