在VBA中使用Base64将图像插入到工作表中？

问题描述：

我想用VBA使用Base64插入图像到工作表，但我找不到任何示例如何正确地在任何地方做到这一点。在VBA中使用Base64将图像插入到工作表中？

我对图像的字符串设置，是这样的：

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。

这里是一个Base64库。参见：http://www.source-code.biz/snippets/vbasic/12.htm –

我写了一个[VB6/VBA Base64类]（http://www.vbforums.com/showthread.php?379072-VB -Fast-Base64-Encoding-and-Decoding）***方式***当天回来。请注意，由于字符串转换，它在编码方面存在一些问题。这可能是一个好的开始。 – Comintern

@RyanWildry我对此有所了解，对于我应该做什么不是很清楚，我遇到的第一个问题是我的变量不是4的倍数，所以我删除了该部分：'data：image/png; base64，'然后一旦它解码我不能插入，因为它不是一个图片被发送到图片插入。 – Ryflex

答

MSXML库中有一个可在VBA中使用的base64编码。还有的例子在网路上敲了一堆，其中核心功能不断弹出：（！2005）

Experts Exchange它引用的下一个项目
Something by a Tim Hastings according to Wayback machine
Stack Overflow
Travis Hydzik's blog

我已经基本解除了相同的代码，它需要一个字符串并返回一个base64字节数组，然后使用OP的临时文件方法将图像加载回工作表。我整理了一下，使用了晚期绑定，并加入了一些测试。测试工作对我来说很好用Excel 2010：

测试中的问题以base64字符串似乎不工作：

iVBORw0KGgoAAAANSUhEUgAAAZoAAABfCAY

给出：

代码：

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

在VBA中使用Base64将图像插入到工作表中？

相关推荐