时间戳

首页 > 解决方案 > 使用服务器路径中的图像在 Excel 中动态插入

excel - 使用服务器路径中的图像在 Excel 中动态插入

问题描述

我有下面的代码来查找我们服务器中特定文件夹中的 sku 图像并插入 /autosize - 但我遇到的问题是，如果我将此电子表格发送给不在服务器上的任何其他人，他们将看不到图像。有人可以帮助解决这个问题，以便动态插入图像吗？我相信这是在工作表更新/打开时将实际图像放置在工作表中而不是链接回所必须做的事情。或者，如果图像未链接到服务器，我该如何格式化以发送并包含图像？我查看了其他有关动态插入的帖子，但我无法正常工作

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

标签： excelvbaimagedynamic

解决方案

基于问题VBA to insert embedded picture的两个答案，使用Shapes.AddPicture（或者Shapes.AddPicture2如果您想在插入时压缩图片。）

  • LinktoFile是msoFalse
  • SaveWithDocument是msoTrue
  • Width和Height分别是-1为了保留图片的现有尺寸
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

推荐阅读