在 VBA 中使用 Base64 将图像插入工作表? [英] Inserting an Image into a sheet using Base64 in VBA?
问题描述
我正在尝试使用 Base64 将图像插入到带有 VBA 的工作表中,但我在任何地方都找不到如何正确执行此操作的示例.
我为图像设置了一个字符串,例如:
vLogo = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAZoAAABfCAY"
我只想执行以下操作,但不是寻找图像文件,而是将图像存储在 VBA 中.
Sheets("Sheet1").Pictures.Insert (Application.ActiveWorkbook.Path & "vLogo.png")
我什至看过做类似的事情:
' 将图像写入文件将 myFile 调暗为字符串myFile = Application.ActiveWorkbook.Path & emp.png"打开 myFile 以输出为 #1写#1,vLogo关闭 #1' 插入图片Sheets("Sheet1").Pictures.Insert (Application.ActiveWorkbook.Path & " emp.png")' 删除临时文件杀死 Application.ActiveWorkbook.Path & emp.png"
但我不知道如何将 base64 编码的图像写入文件.
MSXML 库中有一个base64 编码,可以在VBA 中使用.网上有很多例子,核心功能不断弹出:
在问题中测试base64字符串似乎不起作用:
<块引用>iVBORw0KGgoAAAANSUhEUgAAAZoAAABfCAY
给予:
代码:
选项显式子测试()将 strTempPath 调暗为字符串将 arrTest(1 到 3) 调暗为字符串将 intCounter 调暗为整数'base 64 图像示例'红点arrTest(1) = "iVBORw0KGgoAAAANSUhEUgAAAAUAAAAFCAYAAACNbyblAAAAHElEQVQI12P4//8/w38GIAXDIBKE0DHxgljNBAAO9TXL0Y4OHwAAAABJRU5ErkJggg=="'小脸标志arrTest(2) = "R0lGODlhDwAPAKECAAAAzMzM/////wAAACwAAAAADwAPAAACIISPeQHsrZ5ModrLlN48CXF8m2iQ3YmmKqVlRtW4MLwWACH+H09wdGltaXplZCBieSBVbGVhZCBTbWFydFNhdmVyIQAAOw=="'堆栈溢出标志arrTest(3) = GetSOLogoBase64'使用工作簿路径作为临时路径strTempPath = Application.ActiveWorkbook.Path & emp.png"对于 intCounter = 1 到 3'保存字节数组到临时文件为二进制打开 strTempPath #1把#1, 1, DecodeBase64(arrTest(intCounter))关闭 #1'从临时文件中插入图片Sheets("Sheet1").Cells(intCounter * 4, 1).SelectSheets("Sheet1").Pictures.Insert strTempPath'杀死临时文件杀死 strTempPath下一个 intCounter结束子私有函数 DecodeBase64(ByVal strData As String) As Byte()将 objXML 作为对象调暗 'MSXML2.DOMDocument将 objNode 调暗为对象 'MSXML2.IXMLDOMElement'获取dom文件设置 objXML = CreateObject("MSXML2.DOMDocument")'创建base 64类型的节点并解码设置 objNode = objXML.createElement("b64")objNode.DataType = "bin.base64"objNode.Text = strDataDecodeBase64 = objNode.nodeTypedValue'清理设置 objNode = 无设置 objXML = 无结束功能函数 GetSOLogoBase64() 作为字符串GetSOLogoBase64 = ""GetSOLogoBase64 = GetSOLogoBase64 &iVBORw0KGgoAAAANSUhEUgAAAAAAAAAA4CAMAAAC7bYapAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvq"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 &xCO0MZHz2AdFuevvwVerRldpndVSZ98GqPKOB3Oyyt3kOZhOqOWDm1jUe1gq5ypOJqwi+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/RA2L6ggAAAAAASUVORK5CYII="结束功能
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 & " emp.png" Open myFile For Output As #1 Write #1, vLogo Close #1 ' Insert the image Sheets("Sheet1").Pictures.Insert (Application.ActiveWorkbook.Path & " emp.png") ' Delete the temp file Kill Application.ActiveWorkbook.Path & " emp.png"
But I can't figure out how to write the base64 encoded image to file.
解决方案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 & " emp.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 将图像插入工作表?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!