Can't insert pictures in Excel with VBA

Question

I am getting completely crazy about this issue, please help me.

I have made a shell script that writes in a text file the path of some images that are stored in a folder. Then I use an excel code to read each path and write it in an excel cell. I have then made a code that should take that path and use it to insert the picture. I have tried with Pictures.insert(path) and shapes.addpictures "path", but I have the same issue every time, the picture can't be loaded. What's weird, is that, if I manually insert the picture before and then delete it, the code will perfectly load the picture. But if it's the first time then no. The paths that I'm using look like that: "/Users/theodorebedos/Documents/code_tilly/new_pict_tilly/IMG_9040.jpg"

I'm using a mac, maybe that matters?

Private Sub Convert_Img()

Dim myPict As Picture
Dim PictureLoc As String
Dim EndPictRow, i As Integer
Dim StartPath As String


If Worksheets("Main").Cells(3, 1).Value <> "" Then
    EndPictRow = Worksheets("Main").Range("A2").End(xlDown).Row

    For i = 3 To EndPictRow
        PictureLoc = Worksheets("Main").Cells(i, 1).Value
        Worksheets("Main").Cells(i, 1).ClearContents
        Worksheets("Main").Cells(i, 1).ColumnWidth = 30
        Worksheets("Main").Cells(i, 1).RowHeight = 150
           ActiveSheet.Shapes.AddPicture PictureLoc, False, True, Worksheets("Main").Cells(i, 1).Left, Worksheets("Main").Cells(i, 1).Top, Worksheets("Main").Cells(i, 1).Width, Worksheets("Main").Cells(i, 1).Height

    Next i
End If

End Sub

Edit: When I use "Pictures.insert" or "shapes.addpicture path, true, true " I have no error message in VBA but I have in excel instead of my picture, a blank image with inside an error message like this: image

If I use "shapes.addpicture path, FALSE, true" then I have an error message like this but no image at all is loaded: image 2

And then an error 1004 like that: image3

And if I do the process to have image 1, then I save the document, reopen it, I'll have this directly: image 4

Thanks for you help. It will be much appreciated.

Answer 1

I hope someone will benefit from this old thread. As it turns out this is some sort of a permission issue also noted already in one of the comments, possibly only occurring with Excel 16 macros on OSX.

It seems like Excel is lacking the permissions to access the resources linked and is not asking for them. We need to grant permissions to all files in the folder. The following code demonstrates how to achieve this, given the identifier to build the paths is in Column A2:20. Run this macro (adjust the way the path is built), then grant access once the dialogue appears:

Sub GrantAccess()
    Dim cName As Variant
    Dim files() As Variant
    Set xRange = ActiveSheet.Range("A2:A20")
        For Each cell In xRange
                 ReDim Preserve files(1 To cell.Row - 1)
                 cName = "/Users/adjust-your-path/path" & Cells(cell.Row, "A") & "_thumb_600.png"
                 files(cell.Row - 1) = cName
        Next
        fileAccessGranted = GrantAccessToMultipleFiles(files)
End Sub

Code used:

Sub URLPICInsertMM()
    Dim cShape As Shape
    Dim cRange As Range
    Dim cColumn As Long
    Dim cName As String
    Dim img As Picture
    Application.ScreenUpdating = False
    Set xRange = ActiveSheet.Range("B2:B10")
    For Each cell In xRange
        'cName = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
        ' files are located in thumbs sub-directory       
        cName = "/Users/.../IonChannels/thumbs/" & Cells(cell.Row, "A") & "_thumb_300.png"
        Set img = ActiveSheet.Pictures.Insert(cName)
        img.Select
        Set cShape = Selection.ShapeRange.Item(1)
        If cShape Is Nothing Then GoTo line22
        Cells(cell.Row, "C").Value = "file://" & cName
        Set cRange = Cells(cell.Row, cell.Column)
        With cShape
            .LockAspectRatio = msoTrue
            'If .Width > cRange.Width Then .Width = cRange.Width
            If .Height > cRange.Height Then .Height = cRange.Height
            .Top = cRange.Top + (cRange.Height - .Height)
            .Left = cRange.Left + (cRange.Width - .Width)
        End With
line22:
        Set cShape = Nothing
        Range("T2").Select
    Next
    Application.ScreenUpdating = True
End Sub

Edit:

Evidence:

I created a simple test sheet (the idea is to load some protein visualization thumbs into an excel sheet) with an identifier in Column A, image file descriptors are constructed from the identifier + path and file extension. The image is inserted into Column B and the file descriptor as text into Column C.

When I ran the macro for the first time, only the first image was loaded. Excel formats the file descriptor as a hyperlink. When clicking the file:///... link, Excel opens a dialog that asks to grant permissions to that file (screenshot). If I grant access and accept warnings, then run the macro again, the image appears.

After running macro again, image is displayed:

Answer 2

I streamlined your code so it becomes possible to see what it's doing. Note that I avoided reading values from the cell's properties which were just set or are obvious.

1. Once the column width has been set, the width of all cells in it are the same.
2. The Left property of all cells in a column is always the same.
3. If the column is column A, the Left is always 0.

Of course, what you tried to achieve is to enter a value only once. That is good practice but to read properties from the sheet is slow. The faster way - less code volume and better readable, too - is to declare a constant at the top and use that name in the code.

So you end up with this code.

Private Sub Convert_Img()

    Const ClmWidth As Single = 30
    Const RowHight As Single = 150

    Dim EndPictRow As Long, R As Long
    ' sorry, I recommend i for arrays and R for rows (C for columns)


    With Worksheets("Main")
        ' End(xlDown) will find the first blank cell below the base cell.
        '   There might be more filled cells further down.
        ' End(xlUp) will find the first used cell above the base cell
        '   disregarding more blanks above that one.
        EndPictRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        ' no need to set the column width multiple times in the loop
        .Columns(1).ColumnWidth = ClmWidth

        ' this loop will never run if R < EndPicRow
        For R = 3 To EndPictRow
            With .Cells(R, 1)
                .RowHeight = RowHight
                ' this will work only once:-
                .Worksheet.Shapes.AddPicture CStr(.Value), False, True, 0, .Top, ClmWidth, RowHight
            End With
        Next R
    End With
End Sub

The reason why it works only once becomes quite obvious. The new picture takes its source path from the cell's Value. Of course, once you insert a picture (image) in the cell that value can't be the path (string) anymore. If you run the code a second time it will fail. However, if that is your need, it should be possible to extract the path from the formula that defines the picture in the cell. Given that the picture itself isn't present at that location the formula should either hold the path or a reference to a location within the workbook's background data, depending upon how it was loaded.

Answer 3

Ok, so it's not perfect yet, but I put the loop off and I used Dir() as you said @Variatus.A pop-up window like this opened when I executed the command Dir(). It asked me the authorisation to access the file. I pressed yes and then it worked. It worked but only for that file. So I guess, I am on the right way now and I need to find how to give access to all the files in that folder before running the code. I can't do it for all of them. Thank you very much.