如何将GIF图像嵌入到Excel文件中 [英] How to embed a GIF image into an Excel file

问题描述

通过ActiveX控件Microsoft Web-browser，我们可以在Excel的Web浏览器框中触发GIF文件的导航.为此，我定义了一个按钮并为其分配了macro，该按钮给出了该GIF图像的本地地址(或链接)以进行导航.

Through ActiveX Control Microsoft Web-browser, we can trigger the navigation of a GIF file within a web browser box in Excel. I do this by defining a button and assigning a macro to it which gives the local address (or link) of that GIF image for the navigation to be done.

此问题是，为了使用这种excel文件进​​行演示，您还必须在将要启动的任何计算机上都携带GIF文件.当我们将图像插入Excel文件时，它将被嵌入其中，并且不需要携带真实的图像文件，例如Excel的PNG格式就可以识别要显示的内容.

The problem with this is, in order to use such an excel file for presentation, you have to carry the GIF file too on any computer its going to be launched. While when we insert an image into an Excel file, it will be embedded into it and there is no need to carry the real image file for instance the PNG format for the Excel to be able to recognize what to show.

有人知道Excel对GIF图像的表现如何吗?

Does anyone have any clue how Excel can behave the same for GIF images?

推荐答案

从 http://www.vbaexpress.com/forum/showthread.php?55713-Store-image-in-VBA
如果您不希望将数据放在工作表中，则可以将其移至vba并编写必要的转换代码.

Copied from http://www.vbaexpress.com/forum/showthread.php?55713-Store-image-in-VBA
If you don't want the data on a worksheet you might want to move it to vba and write the necessary conversion code.

如果该代码适合您，您可以在上面提到的网站上对代码的作者说谢谢"！

If the code works for you, you might leave the author of the code a "thank you" on the site mentioned above!

dim pic(1000) as string
pic(1)="47 49 46 38 39 61 F0 00 F0 00 F7 86 00 00 00 ... CD 1B 53"

经过以下测试:

;-)

Option Explicit
Sub Test()
    Dim Filename As String
      ' Save picture to the worksheet Hex Byte Data.
        Filename = "c:\temp\smiley.gif"
        Call SaveAsHexFile(Filename)

      ' Restore the file to the user's Temp directory.
        Filename = RestoreHexFile
        Debug.Print Filename

      ' Filename now is the complete file path to the restored file.
      ' Pass this to another macro or application.
End Sub

Private Sub SaveAsHexFile(ByVal Filename As String)
    Dim c        As Long
    Dim DataByte As Byte
    Dim Data()   As Variant
    Dim i        As Long
    Dim n        As Integer
    Dim r        As Long
    Dim Wks      As Worksheet
    Dim x        As String

        If Dir(Filename) = "" Then
            MsgBox "The File '" & Filename & "' Not Found."
            Exit Sub
        End If

        On Error Resume Next
            Set Wks = Worksheets("Hex Byte Data")
            If Err = 9 Then
                Worksheets.Add After:=Worksheets.Count
                Set Wks = ActiveSheet
                Wks.Name = "Hex Byte Data"
            End If
        On Error GoTo 0

        Wks.Cells.ClearContents
        Wks.Cells(1, "AH").Value = Dir(Filename)

        n = FreeFile

        Application.ScreenUpdating = False
        Application.ErrorCheckingOptions.NumberAsText = False

            With Wks.Columns("A:AF")
                .NumberFormat = "@"
                .Cells.HorizontalAlignment = xlCenter

                Open Filename For Binary Access Read As #n
                    ReDim Data((LOF(n) - 1) \ 32, 31)

                    For i = 0 To LOF(n) - 1
                        Get #n, , DataByte
                        c = i Mod 32
                        r = i \ 32
                        x = Hex(DataByte)
                        If DataByte < 16 Then x = "0" & x
                        Data(r, c) = x
                    Next i
                Close #n

                Wks.Range("A1:AF1").Resize(r + 1, 32).Value = Data
                .Columns("A:AF").AutoFit
            End With

        Application.ScreenUpdating = True

End Sub

Function RestoreHexFile() As String

    Dim Cell    As Range
    Dim Data()  As Byte
    Dim File    As String
    Dim j       As Long
    Dim LSB     As Variant
    Dim MSB     As Variant
    Dim n       As Integer
    Dim Rng     As Range
    Dim Wks     As Worksheet

        On Error Resume Next
            Set Wks = Worksheets("Hex Byte Data")
            If Err <> 0 Then
                MsgBox "The Worksheet 'Hex Byte Data' is Missing.", vbCritical
                Exit Function
            End If
        On Error GoTo 0

        Set Rng = Wks.Range("A1").CurrentRegion

        File = Wks.Cells(1, "AH").Value
        File = Replace(File, ".", "_NEW.")

        If File <> "" Then
            n = FreeFile
            File = Environ("TEMP") & "\" & File

            Open File For Binary Access Write As #n
                ReDim Data(Application.CountA(Rng) - 1)

                For Each Cell In Rng
                    If Cell = "" Then Exit For

                    MSB = Left(Cell, 1)
                    If IsNumeric(MSB) Then MSB = 16 * MSB Else MSB = 16 * (Asc(MSB) - 55)

                    LSB = Right(Cell, 1)
                    If Not IsNumeric(LSB) Then LSB = (Asc(LSB) - 55) Else LSB = LSB * 1

                    Data(j) = MSB + LSB
                    j = j + 1
                Next Cell

                Put #n, , Data
            Close #n
        End If
       RestoreHexFile = File
End Function

这篇关于如何将GIF图像嵌入到Excel文件中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！