Shapes.AddPicture - Application-Defined or Object-Defined Error

[khabi21]

This macro is supposed to add the most recent picture from my camera roll and insert it in the designated cell in Excel when a button is pressed on the worksheet. This macro was working at one point, but my guys ran into an issue with it last week, and I can't figure out why. It is giving me an Application-defined or Object-defined error at the "Shapes.AddPicture" line below.

I am working with Excel 2010. Any help would be appreciated.

Private Sub GetMostRecentImageTrend()


'When the trend screen button on the "Pictures" tab is pressed, this macro will insert the most recent image.


    Dim FileSys As FileSystemObject
    Dim objFile As File
    Dim myFolder
    Dim strFileName As String
    Dim dteFile As Date
    Dim myDir As String
    Dim pic As Object
        
    'Set path for files:
    myDir = Environ("USERPROFILE") & "\Pictures\Camera Roll"
    
    'Set up filesys objects:
    Set FileSys = New FileSystemObject
    Set myFolder = FileSys.GetFolder(myDir)
    
    'Loop through each file & get date last modified. If largest date (most recent) then store Filename:
    dteFile = DateSerial(1900, 1, 1)
    For Each objFile In myFolder.Files
        If objFile.DateLastModified > dteFile Then
            dteFile = objFile.DateLastModified
            strFileName = objFile.Name
        End If
    Next objFile
    
    'Insert the image into the designated cell.
    With Application.ActiveWorkbook.Sheets("Pictures").Shapes.AddPicture(myFolder & "\" & strFileName, False, True, 1, _
    1, -1, -1)
        .Top = ActiveWorkbook.Sheets("Pictures").Range("B9").Top
        .Left = ActiveWorkbook.Sheets("Pictures").Range("B9").Left
        .Height = ActiveWorkbook.Sheets("Pictures").Range("B9:B42").Height
        .Width = ActiveWorkbook.Sheets("Pictures").Range("B9:J9").Width
    End With
    
    'Delete the picture from the camaera roll directory after pasting:
    Kill (myFolder & "\" & strFileName)
        
End Sub

 

[khabi21]

Can you manually add the picture from the roll?

Aha! So I had the sheet protected so that the guys can only click the button and the cell that the picture is inserted into. I took off the protection to try it manually and it worked manually. So then I clicked the button while unprotected, and the code worked.

I would still like the sheet to be protected so they can't mess with stuff on the sheet other than the cell that the picture is added to. Is there a way I can do this without causing that error? Or do I just have to leave it unprotected?

 

[khabi21]

Aha! So I had the sheet protected so that the guys can only click the button and the cell that the picture is inserted into. I took off the protection to try it manually and it worked manually. So then I clicked the button while unprotected, and the code worked.

I would still like the sheet to be protected so they can't mess with stuff on the sheet other than the cell that the picture is added to. Is there a way I can do this without causing that error? Or do I just have to leave it unprotected?

I ended up allowing "Edit Objects" when locked and this fixed the issue while still allowing it to be protected.

Thank you Norie for the help!

 

[Norie]

Thought that might be what was happening.

You can easily fix it, hopefully, by adding code to unprotect/protect the sheet to the original code.

At its simplest that might look something like this.

Private Sub GetMostRecentImageTrend()


'When the trend screen button on the "Pictures" tab is pressed, this macro will insert the most recent image.


Dim FileSys As FileSystemObject
Dim objFile As File
Dim myFolder
Dim strFileName As String
Dim dteFile As Date
Dim myDir As String
Dim pic As Object

    'Set path for files:
    myDir = Environ("USERPROFILE") & "\Pictures\Camera Roll"

    'Set up filesys objects:
    Set FileSys = New FileSystemObject
    Set myFolder = FileSys.GetFolder(myDir)

    'Loop through each file & get date last modified. If largest date (most recent) then store Filename:
    dteFile = DateSerial(1900, 1, 1)
    For Each objFile In myFolder.Files
        If objFile.DateLastModified > dteFile Then
            dteFile = objFile.DateLastModified
            strFileName = objFile.Name
        End If
    Next objFile

    'Insert the image into the designated cell.
    With ActiveWorkbook.Sheets("Pictures")
        .Unprotect
        With .Shapes.AddPicture(myFolder & "\" & strFileName, False, True, 1, _
                                1, -1, -1)
            .Top = ActiveWorkbook.Sheets("Pictures").Range("B9").Top
            .Left = ActiveWorkbook.Sheets("Pictures").Range("B9").Left
            .Height = ActiveWorkbook.Sheets("Pictures").Range("B9:B42").Height
            .Width = ActiveWorkbook.Sheets("Pictures").Range("B9:J9").Width
        End With
        .Protect
    End With
    'Delete the picture from the camaera roll directory after pasting:
    Kill (myFolder & "\" & strFileName)

End Sub