在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。

來源

2016-08-24 Ryflex

這裏是一個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

來源

2016-08-30 08:08:30

在VBA中使用Base64將圖像插入到工作表中？

回答

相關問題