Using base64 data stored in CustomXMLPart as image in Office

后端 未结 1 1157
梦如初夏
梦如初夏 2021-01-01 06:28

As a followup to this question about using images stored in an Excel file on a button in the ribbon:

Is it possible to use an image stored in a CustomXMLPart/CustomX

相关标签:
1条回答
  • 2021-01-01 06:54

    First you need to convert your base_64 data to byte array:

    Private Function decodeBase64(ByVal strData As String) As Byte()
        Dim objXML As MSXML2.DOMDocument
        Dim objNode As MSXML2.IXMLDOMElement
    
        Set objXML = New MSXML2.DOMDocument
        Set objNode = objXML.createElement("b64")
        objNode.DataType = "bin.base64"
        objNode.Text = strData
        decodeBase64 = objNode.nodeTypedValue
    
        Set objNode = Nothing
        Set objXML = Nothing
    End Function
    

    from: http://thydzik.com/vb6vba-functions-to-convert-binary-string-to-base64-string/

    then you can load it in memory and create your IPictureDisp using information on this topic: http://www.xtremevbtalk.com/showthread.php?t=137857

    Type GUID
      Data1 As Long
      Data2 As Integer
      Data3 As Integer
      Data4(7) As Byte
    End Type
    
    Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByRef hGlobal As Any,     ByVal fDeleteOnResume As Long, ByRef ppstr As Any) As Long
    Private Declare Function OleLoadPicture Lib "olepro32.dll" (ByVal lpStream As IUnknown, ByVal lSize As Long, ByVal fRunMode As Long, ByRef riid As GUID, ByRef lplpObj As Any) As Long
    Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef pclsid As GUID) As Long
    
    Private Const SIPICTURE As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
    
    Public Function PictureFromArray(ByRef b() As Byte) As IPicture
      On Error GoTo errorhandler
    
      Dim istrm As IUnknown
      Dim tGuid As GUID
    
      If Not CreateStreamOnHGlobal(b(LBound(b)), False, istrm) Then
        CLSIDFromString StrPtr(SIPICTURE), tGuid
        OleLoadPicture istrm, UBound(b) - LBound(b) + 1, False, tGuid, PictureFromArray
      End If
    
      Set istrm = Nothing
      Exit Function
    errorhandler:
      Debug.Print "Could not convert to IPicture!"
    End Function
    
    0 讨论(0)
提交回复
热议问题