使用VBA中的Base64将图像插入到工作表中?

时间:2016-08-24 14:49:56

标签: excel vba excel-vba base64

我正在尝试使用Base64将图像插入到使用VBA的工作表中,但我找不到任何在任何地方正确执行此操作的示例。

我有一个图像的字符串设置,如:

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

我只想执行以下操作,但不是查找图像文件而是将图像存储在VBA中。

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

我甚至看过这样的事情:

' 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"

但我无法弄清楚如何将base64编码的图像写入文件。

1 个答案:

答案 0 :(得分:6)

MSXML库中有一个base64编码,可以在VBA中使用。有很多例子在网络上敲响核心功能不断涌现:

我基本上提取了相同的代码,它接受一个字符串并返回一个base64字节数组,然后使用OP的临时文件方法将图像加载回工作表。我已经整理了一下,使用了后期绑定加上一些测试。 Excel 2010上的测试效果很好:

enter image description here

在问题中测试base64字符串似乎不起作用:

  

iVBORw0KGgoAAAANSUhEUgAAAZoAAABfCAY

给出:

enter image description here

代码:

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