![]() |
#1
|
|||
|
|||
![]() Hi all My engineering firm uses a VBA code to insert a batch of JPG images from a folder into a captioned table in a Word file as a report template. Recently we "upgraded" to Microsoft 365 and began having issues where the code would either not properly place the images into the table, or would produce run-time error 5941. Being semi-intelligent, I noticed that this issue coincided with the switch to MS 365 so I back-saved a report template file to Word 2003. Lo and behold, the macro worked properly. However, I would prefer to not have to use a workaround and would love for some of the experts here to help me properly solve this problem! DISCLAIMER: I know nothing about VBA so treat me as a complete layperson. The code was created about 20 years ago by a programmer we had as an intern. Here is the current macro code: Sub InsertMultipleImagesFixed() Dim fd As FileDialog Dim oTable As Table Dim iRow As Integer Dim iCol As Integer Dim oCell As range Dim i As Long Dim sNoDoc As String Dim picName As String Dim scaleFactor As Long Dim max_height As Single Dim img As Picture Dim docrange As range 'define resize constraints max_height = 275 Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .Title = "Select image files and click OK" .Filters.Add "Images", "*.gif; *.jpg; *.jpeg; *.bmp; *.tif; *.png; *.wmf" .FilterIndex = 2 If .Show = -1 Then Set docrange = ActiveDocument.Content With docrange.Find .Replacement.ClearFormatting .Text = "TotalImageNumber" .Replacement.Text = fd.SelectedItems.Count .Execute Replace:=wdReplaceAll End With For i = 1 To .SelectedItems.Count Selection.EndKey Unit:=wdStory 'add a 1 row 2 column table to take the images Set oTable = Selection.Tables.Add(Selection.range, 1, 2) '+++++++++++++++++++++++++++++++++++++++++++++ iCol = 2 iRow = i Selection.Tables(1).Borders.Enable = blnTblBorders Selection.Tables(1).PreferredWidthType = wdPreferredWidthPercent Selection.Tables(1).PreferredWidth = 100 Selection.Tables(1).Rows.Alignment = wdAlignRowCenter Selection.Tables(1).Columns(1).Width = 140 Selection.Tables(1).Columns(1).Select ActiveDocument.ActiveWindow.Selection.ParagraphFor mat.Alignment = wdAlignParagraphLeft Selection.Font.Size = 12 Selection.Font.Underline = wdUnderlineSingle Selection.TypeText Text:="Photograph No. " & i Selection.Font.Underline = wdUnderlineNone Selection.TypeText Text:=":" ActiveDocument.ActiveWindow.Selection.TypeParagrap h ActiveDocument.ActiveWindow.Selection.ParagraphFor mat.RightIndent = InchesToPoints(0.02) ActiveDocument.ActiveWindow.Selection.ParagraphFor mat.Alignment = wdAlignParagraphLeft ActiveDocument.ActiveWindow.Selection.ParagraphFor mat.SpaceBeforeAuto = False ActiveDocument.ActiveWindow.Selection.ParagraphFor mat.SpaceAfterAuto = False Selection.Tables(1).Columns(2).Width = 400 Selection.Tables(1).Columns(2).Select ActiveDocument.ActiveWindow.Selection.ParagraphFor mat.RightIndent = InchesToPoints(0.01) ActiveDocument.ActiveWindow.Selection.ParagraphFor mat.Alignment = wdAlignParagraphLeft ActiveDocument.ActiveWindow.Selection.ParagraphFor mat.SpaceBeforeAuto = False ActiveDocument.ActiveWindow.Selection.ParagraphFor mat.SpaceAfterAuto = False 'insert image Selection.InlineShapes.AddPicture FileName:=imageLoc & _ .SelectedItems(i), LinkToFile:=False, SaveWithDocument:=True 'resize image ActiveDocument.InlineShapes(i + 1).Fill.Visible = msoFalse ActiveDocument.InlineShapes(i + 1).Fill.Solid ActiveDocument.InlineShapes(i + 1).Fill.Transparency = 0# ActiveDocument.InlineShapes(i + 1).Line.Weight = 0.75 ActiveDocument.InlineShapes(i + 1).Line.Transparency = 0# ActiveDocument.InlineShapes(i + 1).Line.Visible = msoFalse ActiveDocument.InlineShapes(i + 1).LockAspectRatio = msoTrue ActiveDocument.InlineShapes(i + 1).Height = 288 ActiveDocument.InlineShapes(i + 1).Width = 383.75 ActiveDocument.InlineShapes(i + 1).PictureFormat.Brightness = 0.5 ActiveDocument.InlineShapes(i + 1).PictureFormat.Contrast = 0.5 ActiveDocument.InlineShapes(i + 1).PictureFormat.ColorType = msoPictureAutomatic ActiveDocument.InlineShapes(i + 1).PictureFormat.CropLeft = 0# ActiveDocument.InlineShapes(i + 1).PictureFormat.CropRight = 0# ActiveDocument.InlineShapes(i + 1).PictureFormat.CropTop = 0# Selection.ParagraphFormat.Alignment = wdAlignParagraphRight Selection.WholeStory Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.TypeParagraph Next i End If End With End Sub |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
Edszx | Word VBA | 2 | 05-27-2019 11:16 PM |
![]() |
puff | Word VBA | 5 | 01-17-2018 04:32 PM |
Single Image Selection / Shortcut Key (Mac Excel 2011) Troubleshooting | chendric3 | Excel Programming | 0 | 04-14-2017 11:04 AM |
![]() |
equalizer88 | Word VBA | 3 | 08-16-2015 04:56 PM |
![]() |
stanleyhuang | Word | 3 | 09-11-2014 12:51 AM |