View Single Post
 
Old 02-13-2024, 07:51 PM
Cusaty Cusaty is offline Mac OS X Office 2021
Novice
 
Join Date: Feb 2024
Posts: 2
Cusaty is on a distinguished road
Default Help with converting a macro that works on windows to Mac OS

I have a macro that I use to insert photos into a word document on windows computers. I want to use the same macro on Mac OS and I am having difficulty. I am getting an error and it won’t run the macro.

Here is the macro:

Sub InsertMultipleImagesFixed()
Dim fd As FileDialog
Dim imgCount As Long
Dim imgTable As Table
Dim index As Long
Dim img As InlineShape
Dim imageLoc As Variant

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
End With
If fd.Show = -1 Then
imgCount = fd.SelectedItems.Count

With ActiveDocument
With .Content.Find
.Replacement.ClearFormatting
.Text = "TotalImageNumber"
.Replacement.Text = imgCount
.Execute Replace:=wdReplaceAll
End With
Set imgTable = .Tables.Add(Range:=.Characters.Last, NumRows:=imgCount, NumColumns:=2)
End With

'apply table settings
With imgTable
.Borders.Enable = False
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
.Rows.Alignment = wdAlignRowCenter
.Columns(1).Width = 140
.Columns(2).Width = 400
End With

'loop through table adding images and text
For index = 1 To imgCount

With imgTable.Cell(index, 1).Range
With .ParagraphFormat
If index > 1 Then .SpaceBefore = 12
End With
With .Font
.Size = 12
.Underline = wdUnderlineSingle
End With
.Text = "Photograph No. " & index & ":"
.Characters(.Characters.Count - 1).Font.Underline = wdUnderlineNone
.InsertParagraphAfter
With .Paragraphs.Last.Range
.Font.Underline = wdUnderlineNone
With .ParagraphFormat
.RightIndent = InchesToPoints(0.02)
.SpaceBefore = 0
'the following are likely unnecessary
'.SpaceBeforeAuto = False
'.SpaceAfterAuto = False
End With
End With
End With
With imgTable.Cell(index, 2).Range.ParagraphFormat
.RightIndent = InchesToPoints(0.01)
If index > 1 Then .SpaceBefore = 12
'the following are likely unnecessary
'.SpaceBeforeAuto = False
'.SpaceAfterAuto = False
End With
'insert image
Set img = _
ActiveDocument.InlineShapes.AddPicture(FileName:=i mageLoc & fd.SelectedItems(index), _
LinkToFile:=False, SaveWithDocument:=True, Range:=imgTable.Cell(index, 2).Range)

'resize image
With img
With .Fill
.Visible = msoFalse
.Solid
.Transparency = 0
End With
With .Line
.Weight = 0.75
.Transparency = 0#
.Visible = msoFalse
End With
'I suspect the above should simply be
'.Fill.Visible = msoFalse
'.Line.Visible = msoFalse

.LockAspectRatio = msoTrue
.Height = 288
.Width = 383.75
With .PictureFormat
.Brightness = 0.5
.Contrast = 0.5
.ColorType = msoPictureAutomatic
'these should all be unnecessary
' .CropLeft = 0#
' .CropRight = 0#
' .CropTop = 0#
End With
End With
Next index
End If
End Sub
Reply With Quote