Inserting image Dynamically after calling from a path

[Kristie390]

I had a lot of help getting this sub working on here so I thought I would ask for one more additional mod to get this going,
I have code below to look for an image of a sku in a specific folder in our server and insert /autosize - but the issue i have is that if I send this spreadsheet to anyone else not on the server, they cannot see images. Can someone help fix this so it inserts the image dynamically? I believe this is what has to be done to place the actual image in the sheet rather than link-back when the sheet is updated/Opened. Or, how can I format this to send out and include images if they are not linked to the server? I have looked at other posts which refer to inserting dynamically but I cant get anything to work

Sub Imageupdate()
' inserts the picture files listed in col A into the workbook,
' and sizes and centers in col B


Const sPath As String = "S:\Images\Bulova"
'Const sPath As String = "C:\Users\shg\Pictures\shg"
Dim cell As Range
Dim sFile As String
Dim oPic As Picture


For Each cell In Range("A2", Cells(Rows.Count, "A").End(xlUp))
sFile = sPath & cell.Text & ".jpg"
If Len(Dir(sFile)) Then
Set oPic = ActiveSheet.Pictures.Insert(sFile)
oPic.ShapeRange.LockAspectRatio = msoTrue


With cell.Offset(, 1)
If oPic.Height > .Height Then oPic.Height = .Height
If oPic.Width > .Width Then oPic.Width = .Width

oPic.Top = .Top + .Height / 2 - oPic.Height / 2
oPic.Left = .Left + .Width / 2 - oPic.Width / 2
End With
Else
cell.Select
MsgBox sFile & " not found"
End If
Next cell
End Sub

 

[tonyyy]

Kristie390,

You might consider the following...

Sub Imageupdate()
' inserts the picture files listed in col A into the workbook,
' and sizes and centers in col B

Const sPath As String = "S:\Images\Bulova"
'Const sPath As String = "C:\Users\shg\Pictures\shg"
Dim cell As Range
Dim sFile As String
Dim oPic As Shape

For Each cell In Range("A2", Cells(Rows.Count, "A").End(xlUp))
    sFile = sPath & cell.Text & ".jpg"
    If Len(Dir(sFile)) Then
        With cell.Offset(, 1)
            Set oPic = ActiveSheet.Shapes.AddPicture _
                (Filename:=sFile, linktofile:=msoFalse, savewithdocument:=msoTrue, _
                Top:=.Top, Left:=.Left, Height:=-1, Width:=-1)
            With oPic
                .LockAspectRatio = msoTrue
                If .Height > cell.Offset(, 1).Height Then .Height = cell.Offset(, 1).Height
                If .Width > cell.Offset(, 1).Width Then .Width = cell.Offset(, 1).Width
                
                .Top = cell.Offset(, 1).Top + cell.Offset(, 1).Height / 2 - .Height / 2
                .Left = cell.Offset(, 1).Left + cell.Offset(, 1).Width / 2 - .Width / 2
            End With
         End With
    Else
        cell.Select
        MsgBox sFile & " not found"
    End If
Next cell
End Sub

Declaring oPic as a Shape rather than a Picture and using the Shapes.AddPicture method will allow you to save the picture with the file.

Please note the code is untested.

Cheers,

tonyyy

 

[Kristie390]

Awesome! Thank you!!!!!!!!!!!!!!!!!!!!!!

 

[tonyyy]

You're very welcome...