Inserting an Image into a sheet using Base64 in VBA?

问题

I'm trying to insert an image into a sheet with VBA using Base64 but I can't find any examples of how to do it correctly anywhere.

I have a string setup for the image, something like:

vLogo = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAZoAAABfCAY"

I just want to do the following, but instead of looking for an image file store the image in the VBA.

Sheets("Sheet1").Pictures.Insert (Application.ActiveWorkbook.Path & "\vLogo.png")

I've even looked at doing something like:

' Write the image to file
Dim myFile As String
myFile = Application.ActiveWorkbook.Path & "\temp.png"
Open myFile For Output As #1
Write #1, vLogo
Close #1

' Insert the image
Sheets("Sheet1").Pictures.Insert (Application.ActiveWorkbook.Path & "\temp.png")

' Delete the temp file
Kill Application.ActiveWorkbook.Path & "\temp.png"

But I can't figure out how to write the base64 encoded image to file.

回答1:

There's a base64 encoding in the MSXML library which can be used in VBA. There are a bunch of examples knocking around the web where the core function keeps popping up:

Experts Exchange which references the next item
Something by a Tim Hastings according to Wayback machine (2005!)
Stack Overflow
Travis Hydzik's blog

I've basically lifted the same code which takes a string and returns a base64 byte array then used the OP's temporary file approach to load the image back into the sheet. I've tidied a bit, used late binding plus put in some tests. The tests work well for me on Excel 2010:

Testing the base64 string in the question doesn't seem to work:

iVBORw0KGgoAAAANSUhEUgAAAZoAAABfCAY

Gives:

Code:

Option Explicit

Sub Test()

    Dim strTempPath As String
    Dim arrTest(1 To 3) As String
    Dim intCounter As Integer

    'base 64 image examples
    'red dot
    arrTest(1) = "iVBORw0KGgoAAAANSUhEUgAAAAUAAAAFCAYAAACNbyblAAAAHElEQVQI12P4//8/w38GIAXDIBKE0DHxgljNBAAO9TXL0Y4OHwAAAABJRU5ErkJggg=="
    'little face logo
    arrTest(2) = "R0lGODlhDwAPAKECAAAAzMzM/////wAAACwAAAAADwAPAAACIISPeQHsrZ5ModrLlN48CXF8m2iQ3YmmKqVlRtW4MLwWACH+H09wdGltaXplZCBieSBVbGVhZCBTbWFydFNhdmVyIQAAOw=="
    'Stack Overflow logo
    arrTest(3) = GetSOLogoBase64

    'use workbook path as temp path
    strTempPath = Application.ActiveWorkbook.Path & "\temp.png"

    For intCounter = 1 To 3

        'save byte array to temp file
        Open strTempPath For Binary As #1
           Put #1, 1, DecodeBase64(arrTest(intCounter))
        Close #1

        'insert image from temp file
        Sheets("Sheet1").Cells(intCounter * 4, 1).Select
        Sheets("Sheet1").Pictures.Insert strTempPath

        'kill temp file
        Kill strTempPath

    Next intCounter

End Sub

Private Function DecodeBase64(ByVal strData As String) As Byte()

    Dim objXML As Object 'MSXML2.DOMDocument
    Dim objNode As Object 'MSXML2.IXMLDOMElement

    'get dom document
    Set objXML = CreateObject("MSXML2.DOMDocument")

    'create node with type of base 64 and decode
    Set objNode = objXML.createElement("b64")
    objNode.DataType = "bin.base64"
    objNode.Text = strData
    DecodeBase64 = objNode.nodeTypedValue

    'clean up
    Set objNode = Nothing
    Set objXML = Nothing

End Function

Function GetSOLogoBase64() As String

    GetSOLogoBase64 = ""
    GetSOLogoBase64 = GetSOLogoBase64 & "iVBORw0KGgoAAAANSUhEUgAAANAAAAA4CAMAAAC7bYapAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvq"
    GetSOLogoBase64 = GetSOLogoBase64 & "GQAAADJUExURSIkJi8wMi8xMzw+QD0/QUpMTktNTlhaW1lbXGZnaWdoanR1dnV2d4KDhIOEhZCRkpGSk56en56foKusraytrrm6u7q7u7y7u8"
    GetSOLogoBase64 = GetSOLogoBase64 & "TDw8fIyMjHx8jJyczLy83MzNXV1tnY2N3d3ePj4+bl5e7u7vHx8fLy8vSAJPSHMPSIMfWPPvWQP/aXTPaYTfafWvegW/enZ/eoaPivdfiwdvm"
    GetSOLogoBase64 = GetSOLogoBase64 & "3g/m4hPm/kfrAkvrHnvrIn/vPrPvQrfzXuvzYu/zfyP3gyf3n1f7v4//38f///4l4PkAAAATsSURBVGje7Zh5e5tGEIeXS4CQDArGKlVEQ7pF"
    GetSOLogoBase64 = GetSOLogoBase64 & "cn0kjq8qqiqJ7/+hOjO7LAgdsRWnjXjYPyxgl2HeOX67j1nesMFaoBaoBWqBWqAW6GcGWs+bBbS8zuZNAlpfZtl01aQMzbIsu25UD90B0X1Dg"
    GetSOLogoBase64 = GetSOLogoBase64 & "Nb05wqI5o0AmmczkoXJSbXRfqDlNMse8OL5pNqIHZSD7DOW3Se4eGxAyWGtZdcrod3ZogGisEI9mC4BDX/XDZDtNRYbSgO20e2rbQfBdzrHz4"
    GetSOLogoBase64 = GetSOLogoBase64 & "MgzOPgNYb2AC3l7z0SPRzZRuw7T76JyRizc5+9xtCepZfTp3VVGqiNlvVVYZD+SKAOezMgxJg+rSrSsMwms61lNot/IFAKIJYfvgkQnndgfFm"
    GetSOLogoBase64 = GetSOLogoBase64 & "V0jBf5v8xUAwgaP9NSm5xI5EWUhqudq16NVA6Gu1p/1H6IqDRiB+rckuZpdsFSsOkmp8LkJ3zlIDejdDFNOg6Z6qfLs6c7jteAvEgSOjiHJtc"
    GetSOLogoBase64 = GetSOLogoBase64 & "73EqJo/aHi4GxUTAhfd2hLc9jkAdp18CJV1sKgcgDZihJqbX89yF5+k3ZXslka6/5rNFTXvwiwjEmBahWRpn5D61MtOjAggekPN5Ty7rcHRAx"
    GetSOLogoBase64 = GetSOLogoBase64 & "0d9cqQygd7r4i6K2aYoJHKChfI9AjFxCmasF+1DjxNC+rOSH65rIcQ4NEIE8nwIvqXBNQ81jBa4b0c89vED5IfiiVgxHAoBZs1Eh/HGsA2RNZ"
    GetSOLogoBase64 = GetSOLogoBase64 & "8pr2tAXFcG0oQW5JwJO3jbPwA0//LXPwoJ9TqrHLYjkeRqD/FEznTQIVfccAEE+QxLEY5y7pEPGnkg/DJF/XkUdfTeSvkg3Ooh5PY4xcXD9z3"
    GetSOLogoBase64 = GetSOLogoBase64 & "xCO0MZHz2AdFuevvwVeRldpndVSZ98GqPKOB3Oyyt3kOZhOqOWDm1jUe1gq5ypOJqwi+7oQbkyXUuZk28j62Dv1D62iFRuMqKcfv0NyRnttrQ"
    GetSOLogoBase64 = GetSOLogoBase64 & "HocfAFK1TPfAY1Y0y8cLA38TimkH44zhDXDQgoqk1YDAayMvbjFPCYRAs9BOoTH7gB5vJlk5pp+fa1oN2tML4gpQfObggA/FEL0KkM4sQVEBs"
    GetSOLogoBase64 = GetSOLogoBase64 & "ukXsPopFaHqmm8D2QoIGQZA5UI4+jHZ2QX0fjz+Qyrc/P5GIX3K84/j8W/qwEMNjImSQD2m2Ti2gVjINVndNSBwxBxQpRwHBNXmQt2FEBSzX9"
    GetSOLogoBase64 = GetSOLogoBase64 & "15N4CGw+Hv1a1odkfVB6fSD8Ph+42NMLKg4AVQzCxelBzfBArRcycvthxfSqwvzjW66uhqix4AMssVoAe6jk1lkR33RUDizPB8t9wGyikXtvx"
    GetSOLogoBase64 = GetSOLogoBase64 & "gXPaQxnjtpGBJWSS9FiSh8K/UXGGAHwQq9h6HMpXS666IB1PKsxNo8VQbq11ACZh1N4BS/K4ne6Y8KSRMT4vdPEguOtIvklxDqoQOFtKu3Fh3"
    GetSOLogoBase64 = GetSOLogoBase64 & "AcViH+tcJIHMtCU5BBk/BPSY1caiCtRzUrnvo8Z2ybVucUQA+xr1Z9rpqaNPXxRdojqF9kBoLnluCdUEEO0AimV7WcUyDd0fFBz42MqPBuJQK"
    GetSOLogoBase64 = GetSOLogoBase64 & "t0g6OloBLzXHawe0wkcXSv2P9MhPVZnOW3TcVeE01M7jld46u3MkNhu/JxLIi0p4kOdMygCc2SGQOTQqkU2EtcAA7wPVaN5qSwx/D4ejNRpO2"
    GetSOLogoBase64 = GetSOLogoBase64 & "I6MaQerLPC0t9CQCJy2Y139xD4LJQxDwHJ8OS+a8jOScqt+EWiIMZ2D53EP0laoBMA+nW8c/xyskD7Rwv0EwB9ODQ+NuBfwac4WqAWqAVqgVq"
    GetSOLogoBase64 = GetSOLogoBase64 & "gFuj/HP8CZQ0/RA2L6ggAAAAASUVORK5CYII="

End Function

来源：https://stackoverflow.com/questions/39126617/inserting-an-image-into-a-sheet-using-base64-in-vba

标签

excel

vba

excel-vba

base64