通过 VBA 访问 Excel 表中的图像

Question

我正在用 Excel 设计一个 VBA 表单。工作簿有一个名为“图像”的表格，在里面我从本地硬盘中删除了一些图像。

这些工作簿和用户表单将与我的同事共享。他们的硬盘中可能没有这些图像，但他们会将它们保存在 Excel 表格中。

我正在寻找一种方法来加载“图像”VBA 表单控件内的表格内的图像。

在 Google 中，我只能找到如何从我的硬盘加载图像（即使用“C:/my_images/car.png”之类的绝对路径）。 我找不到的是如何加载表格中的图像，即已经捆绑在工作簿中的图像。

有什么想法吗？

Answer 1

如果你仍然对这个问题感兴趣，我想出了一个解决方案。

首先，您需要将图片从形状导出到文件中。我发现只能使用 .jpg 文件。我的代码生成一个临时文件名（您需要能够读取/写入该路径，但我认为这通常不是问题），并通过将图片插入到 ChartObject 中来保存图片，ChartObject 可以将其内容导出为图片。我想这个过程可能会修改（例如压缩）原始数据，但我在屏幕上没有看到明显的差异。

完成此操作后，它会将此文件中的图片加载到用户窗体上的图像控件中。

最后，它会删除临时文件以清除此副作用。

Option Explicit

' Include: Tools > References > Microsoft Scripting Runtime

Private Sub cmdLoad_Click()
    ' Assumption: The UserForm on which you want to load the picture has a CommandButton, cmdLoad, and this function is its event handler
    Dim imgImageOnForm As Image: Set imgImageOnForm = imgTarget ' TODO: Set which Control you want the Picture loaded into. You can find the Name in the VBA Form Editor's Properties Bar
    Dim strSheetName As String: strSheetName = "TargetSheet" ' TODO: Specify the Name of the Worksheet where your Shape (picture) is
    Dim strShapeName As String: strShapeName = "TargetPicture" ' TODO: Specify the Name of your Shape (picture) on the Worksheet
    Dim strTemporaryFile As String: strTemporaryFile = GetTemporaryJpgFileName ' TODO: Give a path for the temporary file, the file extension is important, e.g. .jpg can be loaded into Form Controls, while .png cannot
    LoadShapePictureToFormControl _
        strSheetName, _
        strShapeName, _
        imgImageOnForm, _
        strTemporaryFile
End Sub

Private Sub LoadShapePictureToFormControl(strSheetName As String, strShapeName As String, imgDst As MSForms.Image, strTemporaryFile As String)
    ' Note: This Sub overwrites the contents of the Clipboard
    ' Note: This Sub creates and deletes a temporary File, therefore it needs access rights to do so
    Dim shpSrc As Shape: Set shpSrc = ThisWorkbook.Worksheets(strSheetName).Shapes(strShapeName)
    Dim strTmp As String: strTmp = strTemporaryFile

    ExportShapeToPictureFile shpSrc, strTmp
    ImportPictureFileToImage strTmp, imgDst
    FileSystem.Kill strTmp
End Sub

Private Sub ExportShapeToPictureFile(shpSrc As Shape, strDst As String)
    shpSrc.CopyPicture xlScreen, xlBitmap
    Dim chtTemp As ChartObject: Set chtTemp = shpSrc.Parent.ChartObjects.Add(0, 0, shpSrc.Width, shpSrc.Height)
    With chtTemp
        .Activate
        .Parent.Shapes(.Name).Fill.Visible = msoFalse
        .Parent.Shapes(.Name).Line.Visible = msoFalse
        .Chart.Paste
        .Chart.Export strDst
        .Delete
    End With
End Sub

Private Sub ImportPictureFileToImage(strSrc As String, imgDst As MSForms.Image)
    Dim ipdLoaded As IPictureDisp: Set ipdLoaded = StdFunctions.LoadPicture(strSrc)
    Set imgDst.Picture = ipdLoaded
End Sub

Private Function GetTemporaryJpgFileName() As String
    Dim strTemporary As String: strTemporary = GetTemporaryFileName
    Dim lngDot As Long: lngDot = InStrRev(strTemporary, ".")
    If 0 < lngDot Then
        strTemporary = Left(strTemporary, lngDot - 1)
    End If
    strTemporary = strTemporary & ".jpg"
    GetTemporaryJpgFileName = strTemporary
End Function

Private Function GetTemporaryFileName() As String
    Dim fsoTemporary As FileSystemObject: Set fsoTemporary = New FileSystemObject
    Dim strResult As String: strResult = fsoTemporary.GetSpecialFolder(TemporaryFolder)
    strResult = strResult & "\" & fsoTemporary.GetTempName
    GetTemporaryFileName = strResult
End Function