检索embedded在Excel文件中的图像
我目前正在将Excel解决scheme升级到Web解决scheme。 在这个过程中，我需要将现有的数据上传到新的（SQL Server）数据库。
问题是，我还需要上传存储在Excel文件中的图像（如形状）。 在数据库中，它们将以字节数组forms存储为PNG格式。
什么是检索任何embedded式图像源的最佳方式？
我目前正在考虑使用ws.Shapes("img_1").CopyPicture和一些API函数来检索它 – 但到目前为止，陷入了搞清楚正确的API函数。 此外，不知道是否没有更容易/更优雅的方式…
如果您不介意将所有图像作为文件存储在磁盘中，然后将其上传到数据库，则可以将Excel工作簿或工作表保存为“网页”。
这将创build一个html文件和一个目录充满了任何图像（每个图像一个PNG文件）的原始Excel文件。
好的，终于find了解决办法。 不知道这是最优雅的版本 – 现在它需要IrfanView或其他转换器 – 但它的工作。 可以用fctStrConvertImageToString(Sheets("YourSheet").Shapes("YorImage"))来调用，并将返回这个图像的PBG作为string：
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