Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #1  
Old 11-28-2023, 07:23 AM
Rfuchs730 Rfuchs730 is offline Insert Batch Image Code - VBA / MS 365 Troubleshooting Windows 10 Insert Batch Image Code - VBA / MS 365 Troubleshooting Office 2021
Novice
Insert Batch Image Code - VBA / MS 365 Troubleshooting
 
Join Date: Nov 2023
Location: New York
Posts: 8
Rfuchs730 is on a distinguished road
Default Insert Batch Image Code - VBA / MS 365 Troubleshooting


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
Reply With Quote
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Insert Batch Image Code - VBA / MS 365 Troubleshooting Batch applying a macro to remove Header and Footer using Batch Auto Addin Edszx Word VBA 2 05-27-2019 11:16 PM
Insert Batch Image Code - VBA / MS 365 Troubleshooting VBA to insert an image and centralize it (code included) 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
Insert Batch Image Code - VBA / MS 365 Troubleshooting VBA batch file to insert text at end of 50 files slow, 90% CPU usage equalizer88 Word VBA 3 08-16-2015 04:56 PM
Insert Batch Image Code - VBA / MS 365 Troubleshooting how to batch update linked image files path? stanleyhuang Word 3 09-11-2014 12:51 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 07:44 AM.


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