Macro to insert photos in cells

Copper Contributor
(Please see attachment for Macro code, I can't figure out how to start each line on a new line in a post) Hi there, I have a macro that inserts photos into cells, activated using a button. The issue is that when the spreadsheet is shared the photos are not appearing and instead an error message appears in their place. The issue appears to be that it is referencing the photo on the local drive on the computer. A solution I have found is to Copy - Paste as Picture but this adds an extra step. I'm wondering if there is some way to set up the macro so that it inserts the photos in a way that allows for the spreadsheet to be shared without losing the photos? Any help would be much appreciated! Please see attachment if the macro below is not displaying properly. Sub insertpic() Dim sFile As Variant, r As Range sFile = Application.GetOpenFilename(FileFilter:="Pic Files (*.jpg;*.bmp), *.jpg;*.bmp", Title:="Browse to select a picture") If sFile = False Then Exit Sub On Error Resume Next Set r = Application.InputBox("Click in the cell to hold the picture", Type:=8) On Error GoTo 0 If r Is Nothing Then Exit Sub If r.Count > 1 Then Exit Sub ActiveSheet.Pictures.Insert (sFile) With ActiveSheet.Shapes(ActiveSheet.Shapes.Count) .LockAspectRatio = True .Top = r.Top .Left = r.Left .Height = 200 End With End Sub
0 Replies