Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
635 views
in Technique[技术] by (71.8m points)

excel - 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 & "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.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

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:

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:

enter image description here

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

iVBORw0KGgoAAAANSUhEUgAAAZoAAABfCAY

Gives:

enter image description here

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

1.4m articles

1.4m replys

5 comments

57.0k users

...