IMAGE控件加载工作表中的图片

netwuxin

IMAGE控件如何加载工作表中的图片
IMAGE控件又如何加载工作表中的图片？如加载工作表sheet1中A1单元格中已插入的图片。

image加载图片是：
Image1.Picture = LoadPicture(pathname)

其中 pathname 为加载图片的路径

若加载工作表中的图片总是提示找不到文件

请问如何加载工作表中的图片？

netwuxin

请问如何加载工作表中的图片？

netwuxin

请问如何加载工作表中的图片？

zldccmx

原帖由 netwuxin 于 2009-8-13 16:56 发表
请问如何加载工作表中的图片？

将图片移出工作表吧

zldccmx

单独一个目录放置图片，然后再LOADPICTURE

netwuxin

代码中提供了一个函数：
LoadShapePicture(shp As Object)
它的使用方法与LoadPicture(FileName)类似，只不过参数中的shp指向的是工作表图形或图表。
Option Explicit
   
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

Public Function LoadShapePicture(shp As Object) As IPictureDisp
    Dim nClipsize As Long
    Dim hMem As Long
    Dim lpData As Long
    Dim sdata() As Byte
    Dim fmt As Long
    Dim fmtName As String
    Dim iClipBoardFormatNumber As Long
    Dim IID_IPicture(15)
    Dim istm As stdole.IUnknown
   
    If TypeName(shp) = "ChartObject" Then
        shp.CopyPicture xlPrinter
        Sheet1.Paste
        Selection.Cut
    Else
        shp.Copy
    End If
   
    OpenClipboard 0&
    If iClipBoardFormatNumber = 0 Then
        fmt = EnumClipboardFormats(0)
        Do While fmt <> 0
            fmtName = Space(255)
            GetClipboardFormatName fmt, fmtName, 255
            fmtName = Trim(fmtName)
            If fmtName <> "" Then
                fmtName = Left(fmtName, Len(fmtName) - 1)
                If fmtName = "GIF" Then
                    iClipBoardFormatNumber = fmt
                    Exit Do
                End If
            End If
            fmt = EnumClipboardFormats(fmt)
         Loop
    End If

    hMem = GetClipboardData(iClipBoardFormatNumber)
    If CBool(hMem) Then
        nClipsize = GlobalSize(hMem)
        lpData = GlobalLock(hMem)
        GlobalUnlock hMem
        If CreateStreamOnHGlobal(hMem, 1, istm) = 0 Then
                If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture(0)) = 0 Then
                   Call OleLoadPicture(ByVal ObjPtr(istm), nClipsize, 0, IID_IPicture(0), LoadShapePicture)
                End If
        End If
    End If

    EmptyClipboard
    CloseClipboard

  End Function

hysj02

多谢netwuxin的帖子。解决了我一个把picture另存为文件的问题。

zhao__feng

谢谢,正在找!

pigpigabc123

果然好用，谢谢！

joyark

谢谢,正在找!