Question

我目前正在将Excel解决方案升级为Web解决方案。在此过程中，我需要将现有数据上载到新的（SQL Server）数据库中。

问题是，我还需要上传存储在Excel文件中的图像（作为形状）。在数据库中，它们将以PNG格式存储为bytearray。

检索任何嵌入图像源的最佳方法是什么？

我目前正在考虑使用ws.Shapes("img_1").CopyPicture和一些API函数来检索它 - 但到目前为止，我一直在寻找正确的API函数。此外，不确定是否有更简单/更优雅的方式...

Answer 1

如果您不介意将所有图像作为磁盘中的文件，然后将其上传到数据库，则可以将Excel工作簿或工作表另存为“网页”。

这将创建一个html文件和一个目录，其中包含原始Excel文件所具有的任何图像（每个图像一个PNG文件）。

Answer 2

好的，终于找到了解决方案。不确定这是最优雅的版本 - 现在它需要IrfanView或其他转换器 - 但它完成了这项工作。可以使用fctStrConvertImageToString(Sheets("YourSheet").Shapes("YorImage"))调用，并将此图像的PBG作为字符串返回：

Option Explicit

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(8) As Byte
End Type

Private Type PICTDESC
    cbSize As Long
    picType As Long
    hImage As Long
End Type

Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd&)
Private Declare Function EmptyClipboard& Lib "user32" ()
Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
Private Declare Function SetClipboardData& Lib "user32" (ByVal wFormat&, ByVal hMem&)
Private Declare Function CloseClipboard& Lib "user32" ()
Private Declare Function CopyImage& Lib "user32" (ByVal handle&, ByVal un1&, ByVal n1&, ByVal n2&, ByVal un2&)
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As String, ByRef lpiid As GUID) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32" (pPictDesc As PICTDESC, ByRef riid As GUID, ByVal fOwn As Long, ByRef ppvObj As IPicture) As Long

Public Function fctStrConvertImageToString(shp As Shape) As String
    Const cStrPath As String = "C:\Temp\"
    Const cStrFileName As String = "temp"
    Const cStrSourceExtension As String = "bmp"
    Const cStrTargetExtension As String = "png"

    Dim strSource As String, strTarget As String


    If shp.Type <> msoPicture Then Exit Function

    shp.CopyPicture 1, xlBitmap

    strSource = cStrPath & cStrFileName & "." & cStrSourceExtension
    strTarget = cStrPath & cStrFileName & "." & cStrTargetExtension

    subSavePicAsBitmap strSource

    subConvertFile strSource, strTarget

    fctStrConvertImageToString = fctStrReadFile(strTarget)

    Kill strSource
    Kill strTarget
End Function

Private Sub subSavePicAsBitmap(strFile As String)
    Const cStrPictureIID = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"

    Dim hCopy&: OpenClipboard 0&
    Dim iPic As IPicture
    Dim tIID As GUID
    Dim tPICTDEST As PICTDESC
    Dim lngReturn As Long

    hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
    CloseClipboard
    If hCopy = 0 Then Exit Sub

    lngReturn = IIDFromString(StrConv(cStrPictureIID, vbUnicode), tIID)
    If lngReturn Then Exit Sub

    With tPICTDEST
        .cbSize = Len(tPICTDEST)
        .picType = 1
        .hImage = hCopy
    End With
    lngReturn = OleCreatePictureIndirect(tPICTDEST, tIID, 1, iPic)

    SavePicture iPic, strFile
End Sub

Private Sub subConvertFile(strSource As String, strTarget As String)
    Const cStrConverter = """c:\Program Files (x86)\IrfanView\i_view32.exe"""
    Shell cStrConverter & " " & strSource & " /convert=" & strTarget, 0
End Sub

Private Function fctStrReadFile(strFile As String)
    Dim hFile As Long

    hFile = FreeFile
    Open strFile For Binary Access Read As #hFile
    fctStrReadFile = Input$(LOF(hFile), hFile)
    Close #hFile

End Function

检索嵌入在Excel文件中的图像

2 个答案: