Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 04-28-2013, 01:12 PM
2whldreams 2whldreams is offline Windows Vista Office 2007
Novice
 
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 Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 16,989
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
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. 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 "Normal" and "Caption" Styles for the image and caption rows, respectively. These both left-align the content, but you can change that and which Styles get used.
Code:
Sub AddPics()
Application.ScreenUpdating = False
Dim i As Long, j As Long, c As Long, r As Long, NumCols As Long
Dim oTbl As Table, TblWdth As Single, StrTxt As String, RwHght As Single
On Error GoTo ErrExit
NumCols = CLng(InputBox("How Many Columns per Row?"))
RwHght = 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
    '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
    End With
    With oTbl
      .AutoFitBehavior (wdAutoFitFixed)
      .Columns.Width = TblWdth / NumCols
    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
        ActiveDocument.InlineShapes.AddPicture _
          FileName:=.SelectedItems(j), LinkToFile:=False, _
          SaveWithDocument:=True, Range:=oTbl.Cell(r, c).Range
        '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 = CentimetersToPoints(Hght)
    .HeightRule = wdRowHeightExactly
    .Range.Style = "Normal"
  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!).

Note that Word also supports an InchesToPoints conversion, which you could use instead of CentimetersToPoints.

To insert the captions above the pictures you need to -
• 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)

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

For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm
For Mac macro installation & usage instructions, see: http://word.mvps.org/Mac/InstallMacro.html
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
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
Images jumping from page to page... Colonel Biggs Drawing and Graphics 13 12-12-2011 08:52 PM
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


All times are GMT -7. The time now is 06:26 PM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft