Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 02-08-2024, 02:55 PM
arcticpinecone arcticpinecone is offline insert photos variation Windows 11 insert photos variation Office 2016
Novice
insert photos variation
 
Join Date: Feb 2024
Posts: 2
arcticpinecone is on a distinguished road
Default insert photos variation

I've reviewed the wonderful resource by @macropod on how to insert pictures https://www.msofficeforums.com/drawi...-document.html

I've also been looking at other posts with code (I'm a complete newbie to all this). I'd like to have many of the same functions that are included in that macro code linked above but I have some differences that I can't figure out how to change. I've used color to indicate my hoped for variations from the original code. This macro should include:
1. prompt to identify/choose folder with photos
2. include caption below picture

3. Iwant two photos per page at the maximum size possible but some photos are landscape and some are portrait. I'm not sure how to specify the row/column size to allow this. In other words, how do I get the macro to resize the photo to a maximum allowable size rather than cut it off?
4. add small line space (6pt) after caption line
5. I'd like the caption to say "Photo filename" WITHOUT any autonumbering because my files are already labelled with numbers like 1a, 1b, etc depending on the number of photopoints at that location.




Finally, how do I save the macro so that it is usable by others at my organization? I tried saving a blank "template with macros enabled" document onto our server but when a coworker opened it up there was nothing there. We do not use Office365 or sign ins. I'm using word 2016.

Thank you!

Last edited by arcticpinecone; 02-09-2024 at 10:15 AM. Reason: added further clarification and detail
Reply With Quote
  #2  
Old 02-12-2024, 08:47 AM
arcticpinecone arcticpinecone is offline insert photos variation Windows 11 insert photos variation Office 2016
Novice
insert photos variation
 
Join Date: Feb 2024
Posts: 2
arcticpinecone is on a distinguished road
Default

I've gotten this closer to what I'd like it to be but still have a few remaining questions. Please help!

How do I...

1) Automatically resize the photos and set a maximum allowable size for height/width? I have photos that are in landscape and portrait and this code unfortunately cuts off the portrait photos (height > width) to the specified row height.
2) save onto the network & share as a template with other users at my organization? Does the macro code need to be created/save to the "Normal.dotm"
3) alter the paragraph/line spacing or other formatting for the caption text? FIGURED IT OUT!! This is so simple and elegant! The code specifies that the caption text will be the same as caption style in Word. So all you have to do is go to that style and modify anything you want (font type, size, line spacing, etc)
4) remove the autonumbering after the caption word "photo"? FIGURED IT OUT!! I had found another post that referenced this but couldn't get it to work. Then I realized I just needed to add "photo" into the code above the line I had modified (both in bold).
Code:
'Get the Image name for the Caption
        StrTxt = Split(.SelectedItems(j), "")(UBound(Split(.SelectedItems(j), "")))
        StrTxt = "Photo: " & 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



Here's code I've modified
Code:
Sub AddPicsWithCaptionJS()
'Sourced from: https://www.msofficeforums.com/drawi...-document.html
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
With ActiveDocument.PageSetup
  TblWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
End With
On Error GoTo ErrExit
NumCols = 1
ColWdth = InchesToPoints(5.5)
RwHght = InchesToPoints(4)
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 & left-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 2-row by NumCols-column table to take the images
    Set oTbl = Selection.Tables.Add(Range:=Selection.Range, NumRows:=2, NumColumns:=NumCols)
    With oTbl
      .AutoFitBehavior (wdAutoFitFixed)
      .TopPadding = 0
      .BottomPadding = 0
      .LeftPadding = 0
      .RightPadding = 0
      .Spacing = 0
      .Columns.Width = ColWdth
      .Borders.Enable = False
    End With
    CaptionLabels.Add Name:="Photo"
    For i = 1 To .SelectedItems.Count Step NumCols
      r = oTbl.Rows.Count - 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 = "Photo: " & 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 = InchesToPoints(0.4)
    .HeightRule = wdRowHeightExactly
    .Range.Style = "Caption"
  End With
End With
End Sub

Last edited by arcticpinecone; 02-12-2024 at 09:17 PM. Reason: changed body text to describe current questions and updated code
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Insert multiple photos only into a specific column in a table PWSJR Word Tables 2 01-25-2023 11:43 AM
insert photos variation report, select all the photos and have the dimensions, width and height of all the photos the same? Giovannino70 Drawing and Graphics 4 11-07-2022 02:57 PM
Macro to insert multiple photos into separate tables Photoinserts Word VBA 0 11-12-2018 08:30 PM
How do I insert a file of sorted photos and retain that order? uncledewey PowerPoint 0 09-03-2017 02:07 PM
Annoying Insert Photos PowerPoint 2016 ajv2u PowerPoint 0 10-29-2015 10:46 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 04:19 AM.


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