Insert Dynamically in Excel using image from server path

问题

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\Casio\"
'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

回答1:

Based on both answers from the question VBA to insert embedded picture, use Shapes.AddPicture (or Shapes.AddPicture2 if you want to compress the picture when inserting.)

LinktoFile is msoFalse
SaveWithDocument is msoTrue
Width and Height are each -1 to preserve the existing dimensions of the picture

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\Casio\"
'Const sPath       As String = "C:\Users\shg\Pictures\shg"
Dim cell          As Range
Dim sFile         As String
Dim shpPic        As Shape
Dim ws            As Worksheet: Set ws = ActiveSheet

With ws
    For Each cell In .Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp))
        sFile = sPath & cell.Text & ".jpg"

        If Len(Dir(sFile)) Then
            Set shpPic = .Shapes.AddPicture(sFile, msoFalse, msoTrue, 0, 0, -1, -1)
            shpPic.LockAspectRatio = msoTrue

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

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

End Sub

来源：https://stackoverflow.com/questions/51860828/insert-dynamically-in-excel-using-image-from-server-path

标签

excel

vba

image

dynamic