Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #16  
Old 12-25-2020, 02:11 PM
victorybadges victorybadges is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2013
Novice
 
Join Date: Dec 2020
Posts: 10
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
  #17  
Old 12-25-2020, 06:05 PM
victorybadges victorybadges is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2013
Novice
 
Join Date: Dec 2020
Posts: 10
victorybadges is on a distinguished road
Default

Hi Paul

I have now being working with the original one with the captions and while I have changed a number of things and can also use Word to improve the output such as centring the caption line the one thing I cannot do is to form fit the text to fit in the prescribed column width, hope you can help.

here is my revised macro for captions
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 row height for the pictures, in Centimeters (e.g. 5)?")))
ColWdth = CentimetersToPoints(CSng(InputBox("What max column width 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
      If TblWdth / NumCols < ColWdth Then ColWdth = TblWdth / NumCols
    End With
    With oTbl
      .AutoFitBehavior (wdAutoFitFixed)
      .TopPadding = 0
      .BottomPadding = 0
      .LeftPadding = 0
      .RightPadding = 0
      .Spacing = 0
      .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
        oTbl.Cell(r + 1, c).Range.Text = StrTxt
        '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

Last edited by macropod; 12-26-2020 at 04:30 AM. Reason: Added code tags
Reply With Quote
  #18  
Old 12-26-2020, 04:52 AM
macropod's Avatar
macropod macropod is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2010
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,726
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

I don't see where you're centring the caption, which in any event should be accomplished by modifying the Caption Style, not by overriding the paragraph format in code. Indeed, your line:
Code:
oTbl.Cell(r + 1, c).Range.Text = StrTxt
eliminates all of Word's implementation of normal captioning conventions.

To fit the text to the cell, you could use the .FitText method. but you don't want to apply that to text that's already less than the cell width. For example:
Code:
        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
            If .Characters.Last.Previous.Information(wdVerticalPositionRelativeToPage) <> _
              .Characters.First.Information(wdVerticalPositionRelativeToPage) Then
              .FitTextWidth = ColWdth
            End If
        End With
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #19  
Old 12-26-2020, 02:31 PM
victorybadges victorybadges is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2013
Novice
 
Join Date: Dec 2020
Posts: 10
victorybadges is on a distinguished road
Default

thank you, I have had trouble so I started off with your original macro for the captions and then placed this last change and it worked fine. However I dont want the label "Picture: ". How do I only show the file name please.
Reply With Quote
  #20  
Old 12-27-2020, 01:55 PM
macropod's Avatar
macropod macropod is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,726
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

For just the text:
To fit the text to the cell, you could use the .FitText method. but you don't want to apply that to text that's already less than the cell width. For example:
Code:
        With oTbl.Cell(r + 1, c).Range
            .Text = StrTxt
            If .Characters.Last.Previous.Information(wdVerticalPositionRelativeToPage) <> _
              .Characters.First.Information(wdVerticalPositionRelativeToPage) Then
              .FitTextWidth = ColWdth
            End If
        End With
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #21  
Old 12-27-2020, 03:16 PM
victorybadges victorybadges is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2013
Novice
 
Join Date: Dec 2020
Posts: 10
victorybadges is on a distinguished road
Default

H Paul
thank you for your latest update
sorry I keep asking you questions
the caption is now fitting as requested however its squeezed against the adjacent captions. Ideally 0.1cm left and right margin or a run time selection for the margin and can you do it so the caption is centred please

thank you
Reply With Quote
  #22  
Old 12-29-2020, 05:29 AM
macropod's Avatar
macropod macropod is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,726
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

Change:
Code:
.FitTextWidth = ColWdth
to:
Code:
.FitTextWidth = ColWdth - CentimetersToPoints(0.1)
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #23  
Old 12-30-2020, 03:51 AM
victorybadges victorybadges is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2013
Novice
 
Join Date: Dec 2020
Posts: 10
victorybadges is on a distinguished road
Default

just tested it thanks
no left indent and not centred
Reply With Quote
  #24  
Old 12-30-2020, 05:30 AM
macropod's Avatar
macropod macropod is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,726
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

As I said in an earlier reply, changes to the caption paragraph's formatting should be done by changing the Style definition. You can do that manually, or by code. In your post previous to that, you said you had already modified things so that you were getting the required centring.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #25  
Old 12-30-2020, 03:26 PM
victorybadges victorybadges is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2013
Novice
 
Join Date: Dec 2020
Posts: 10
victorybadges is on a distinguished road
Default

thanks Paul, sorry I had forgotten regarding centring. No code, I manually highlight the table and click on paragraph centre so that is fine,
so only thing left is the left indent please, if this is too difficult I can increase the CentimetersToPoints from 0.1 to say 0.2 and then centre it.
let me know
Reply With Quote
  #26  
Old 12-31-2020, 02:57 AM
victorybadges victorybadges is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2013
Novice
 
Join Date: Dec 2020
Posts: 10
victorybadges is on a distinguished road
Default

no need to do anything, it works fine, cheers
Reply With Quote
  #27  
Old 12-31-2020, 06:33 AM
macropod's Avatar
macropod macropod is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 20,726
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

Quote:
Originally Posted by victorybadges View Post
No code, I manually highlight the table and click on paragraph centre so that is fine
That is absolutely the wrong way to do it.

To center the captions (the pics are already centered), before:
Code:
      With .Styles("TblPic").ParagraphFormat
insert:
Code:
      .Styles("Caption").ParagraphFormat.Alignment = wdAlignParagraphCenter
It's not apparent why you'd want both centering and indenting in this situation.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #28  
Old 12-31-2020, 10:51 PM
victorybadges victorybadges is offline 4 digital images on 1 page Windows 10 4 digital images on 1 page Office 2013
Novice
 
Join Date: Dec 2020
Posts: 10
victorybadges is on a distinguished road
Default

perfect thanks
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 06:53 AM.


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