使用服务器路径中的图像在Excel中动态插入 [英] Insert Dynamically in Excel using image from server path

问题描述

我有下面的代码在我们服务器的特定文件夹中查找sku的图像并插入/autosize-但我遇到的问题是，如果我将此电子表格发送给服务器上以外的其他任何人，他们将看不到图片.有人可以帮忙解决此问题，以便它动态插入图像吗?我相信这是将实际图像放置在工作表中而不是在更新/打开工作表时回链接所必须要做的.或者，如果未将图像链接到服务器，我该如何格式化以发送并包含图像?我看过其他有关动态插入的文章，但我什么也没做

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

推荐答案

基于问题的两个答案 Shapes.AddPicture2 (如果要在插入时压缩图片).

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 是 msoFalse
• SaveWithDocument 是 msoTrue
• 宽度和高度分别为 -1 ，以保留图片的现有尺寸

• 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

这篇关于使用服务器路径中的图像在Excel中动态插入的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！