通过VBA访问Excel表内部的图像

时间:2019-04-18 16:05:21

标签: excel vba

我正在用Excel设计VBA表单。该工作簿有一个称为“图像”的表,在其中,我从本地硬盘驱动器中放入了一些图像。

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

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

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

有什么想法吗?

1 个答案:

答案 0 :(得分:1)

如果您仍然对此问题感兴趣,我想出了一个解决方案。

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

完成此操作后,它将图片从该文件加载到UserForm的Image控件中。

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

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