Accessing an image that's inside of an Excel Table via VBA

Question

I am designing a VBA Form in Excel. The Workbook has a table called "images", and inside there I am dropping some images from my local hard drive.

These Workbook & UserForm are to be shared with my colleagues. They might not have these images in their harddrive, but they will have them inside of the Excel table.

I am looking for a way to load an image that's inside of a table inside of an "Image" VBA form control.

In Google all I find is how to load an image from my hard drive (i.e. using an absolute path like "C:/my_images/car.png"). What I can't find is how to load an image that's within a table, i.e. already bundled within the Workbook.

Any ideas?

Answer 1

If you are still interested in this question, I came up with a solution.

First you need to export the picture from the shape into a file. I found that only .jpg files can be used. My code generates a temporary filename (you need to be able to read/write that path but I think it is usually not a problem), and saves the picture by inserting it into a ChartObject, which can export its contents as a picture. I suppose this process may modify (e.g. compress) the original data but I saw no visible difference on the screen.

When this is done, it loads the picture from this file into the Image control on the UserForm.

Finally, it deletes the temporary file to clean up this side-effect.

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