通过 VBA 访问 Excel 表中的图像

Posted

技术标签:

【中文标题】通过 VBA 访问 Excel 表中的图像【英文标题】:Accessing an image that's inside of an Excel Table via VBA 【发布时间】:2019-04-18 16:05:21 【问题描述】:

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

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

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

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

有什么想法吗?

【问题讨论】:

我不确定您想要完成的工作是否可行,但这可能会为您提供一些指导/解决方案。 ***.com/questions/23838203/… 谢谢@ZackE。很遗憾 Excel 没有为我们提供一种将图像从表格加载到图像表单控件的简单方法 图片在“表格”中是什么意思?它们是工作表上的形状吗? 当您的同事使用该文件时,该文件可以在他们的计算机上创建(临时)文件吗? 是的@z32a7ul,它们是工作表中的形状(抱歉,我不是说“表格”,我是说“工作表”) 【参考方案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

【讨论】:

以上是关于通过 VBA 访问 Excel 表中的图像的主要内容,如果未能解决你的问题,请参考以下文章

将图像嵌入到 Excel 电子表格 - VBA

如何通过 Access VBA 正确访问 Excel 文件

VBA Excel - 访问查询不可更新

Excel VBA通​​过单击形状更改形状的背景图像

使用VBA在Excel填充单元格中插入多个图像,但保持宽高比

EXCEL VBA:循环正在工作,但在打印到 PDF 文件之前不刷新