Macro for Mac - Adding multiple images to table with captions

Question

Hello Guys

I used to use the following Macro to add multiple images to a table, it then resized the images and added a caption to each image. It worked like a charm on my windows computer. I now have a macbook and it does not work, can someone please assist me with this as it is currently creating "pulling my hair out and deep sigh" moments:

Sub AddPics() 

    Application.ScreenUpdating = False

    Dim oTbl As Table, i As Long, j As Long, k As Long, StrTxt As String

     '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 

             'Add a 2-row by 2-column table with 7cm columns to take the images

            Set oTbl = Selection.Tables.Add(Selection.Range, 2, 2)

            With oTbl 

                .AutoFitBehavior (wdAutoFitFixed)

                .Columns.Width = CentimetersToPoints(7)

                 'Format the rows

                Call FormatRows(oTbl, 1)

            End With 

            CaptionLabels.Add Name:="Picture"

            For i = 1 To .SelectedItems.Count

                j = Int((i + 1) / 2) * 2 - 1

                k = (i - 1) Mod 2 + 1

                 'Add extra rows as needed

                If j > oTbl.Rows.Count Then

                    oTbl.Rows.Add

                    oTbl.Rows.Add

                    Call FormatRows(oTbl, j)

                End If 

                 'Insert the Picture

                ActiveDocument.InlineShapes.AddPicture _

                FileName:=.SelectedItems(i), LinkToFile:=False, _

                SaveWithDocument:=True, Range:=oTbl.Rows(j).Cells(k).Range

                 'Get the Image name for the Caption

                StrTxt = Split(.SelectedItems(i), "")(UBound(Split(.SelectedItems(i), "")))

                StrTxt = ": " & Split(StrTxt, ".")(0)

                 'Insert the Caption on the row below the picture

                With oTbl.Rows(j + 1).Cells(k).Range

                    .InsertBefore vbCr

                    .Characters.First.InsertCaption _

                    Label:="Picture", Title:=StrTxt, _

                    Position:=wdCaptionPositionBelow, ExcludeLabel:=False

                    .Characters.First = vbNullString

                    .Characters.Last.Previous = vbNullString

                End With 

            Next 

        Else 

        End If 

    End With 

    Application.ScreenUpdating = True

End Sub 

 '

Sub FormatRows(oTbl As Table, x As Long)

    With oTbl 

        With .Rows(x) 

            .Height = CentimetersToPoints(7)

            .HeightRule = wdRowHeightExactly

            .Range.Style = "Normal"

        End With 

        With .Rows(x + 1) 

            .Height = CentimetersToPoints(0.75)

            .HeightRule = wdRowHeightExactly

            .Range.Style = "Caption"

        End With 

    End With 

End Sub

Answer 1

MSO File Picker does not exist on the Mac. You have to use MacScript.

Use the following as replacement code:

    Dim iPath As String, iScript As String, iFiles As String, iVol As Variant

    Dim iSplit As Variant, N As Long, OneFile As Boolean, FileFormat As String

    FileFormat = "{""bmp"",""emf"",""emz"",""eps"",""fpix"",""fpx"",""gif"",""jpeg"",""jfif""," & _

                    """jpeg-2000"",""jpg"",""pdf"",""pict"",""pct"",""png"",""pntg"",""psd""," & _

                    """qtif"",""sgi"",""svg"",""tga"",""tpic"",""tiff"",""tif"",""wmf"",""wmz""}"

    OneFile = False

    On Error Resume Next

    iPath = MacScript("return (path to pictures folder) as String")

    iScript = _

        "set theFiles to (choose file of type" & _

        " " & FileFormat & " " & _

        "with prompt ""Please select a file or files"" default location alias """ & _

        iPath & """ with multiple selections allowed)" & vbNewLine & _

        "set thePOSIXFiles to {}" & vbNewLine & _

        "repeat with aFile in theFiles" & vbNewLine & _

        "set end of thePOSIXFiles to POSIX path of aFile" & vbNewLine & _

        "end repeat" & vbNewLine & _

        "set {TID, text item delimiters} to {text item delimiters, ASCII character 10}" & vbNewLine & _

        "set thePOSIXFiles to thePOSIXFiles as text" & vbNewLine & _

        "set text item delimiters to TID" & vbNewLine & _

        "return thePOSIXFiles"

    iFiles = MacScript(iScript)

    On Error GoTo errHandler

    If iFiles <> "" Then

        With Application

            .ScreenUpdating = False

        End With

        iSplit = Split(iFiles, chr(10))

        For N = LBound(iSplit) To UBound(iSplit)

            Debug.Print iSplit(N)

' add your code here

        Next N

        With Application

            .ScreenUpdating = True

        End With

    End If