loading a bitmap into an image control from the clipboard

[Loane Sharp]

Hi there.

In code, can I load a bitmap into an image control from the clipboard?

I've stored the bitmap onto the clipboard in code as follows:

ActiveSheet.ChartObjects("Chart 1").CopyPicture xlScreen, xlBitmap

Normally, I would load a bitmap from a file as follows:

UserForm1.Image1.Picture = LoadPicture(pathname).

Can anyone help?
Thanks,
Loane

 

[Colo[MVP Excel]]

Hello Loane,

Here is a nice sample that Chihiro Fujiwara wrote:
http://park7.wakwak.com/~efc21/cgi-bin/wwwlng.cgi?print+200312/03120341.txt
It's written in Japanese and it is a code for getting the size of the
picture from the clip board.
So I modified the code to suit your needs. Hope this helps.


'

Option Explicit

'Window device
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal
nIndex As Long) As Long

'clip board
Private Const CF_BITMAP = 2
Private Const CF_PALETTE = 9
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long)
As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal
wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As
Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long

'Get a Picture from a handle.
Private Const vbPicTypeBitmap = 1
Private Const vbPicTypeEMetafile = 4
Private Type TPICTDESC
cbSizeofStruct As Long
picType As Long
hImage As Long
Option1 As Long
Option2 As Long
End Type

Private Type TGUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(1 To 8) As Byte
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(lpPictDesc As TPICTDESC,
_
RefIID As TGUID, _
ByVal fPictureOwnsHandle
As Long, _
ByRef IPic As IPicture)
As Long

Public Function Clipboard_GetBITMAP() As StdPicture
Dim hBMP As Long
Dim hPalette As Long
Dim TPICTDESC As TPICTDESC
Dim TGUID As TGUID

Set Clipboard_GetBITMAP = Nothing

If IsClipboardFormatAvailable(CF_BITMAP) = False Then Exit Function
If OpenClipboard(CLng(0)) = False Then Exit Function

hBMP = GetClipboardData(CF_BITMAP)
hPalette = GetClipboardData(CF_PALETTE)
Call CloseClipboard
If hBMP = 0 Then Exit Function

With TPICTDESC
.cbSizeofStruct = Len(TPICTDESC)
.picType = vbPicTypeBitmap
.hImage = hBMP
.Option1 = hPalette
End With
With TGUID
.Data1 = &H20400
.Data4(1) = &HC0
.Data4(8) = &H46
End With
Call OleCreatePictureIndirect(TPICTDESC, TGUID, True,
Clipboard_GetBITMAP)
End Function

Sub Test()
Dim pic As StdPicture
Set pic = Clipboard_GetBITMAP()
If pic Is Nothing Then
MsgBox "Error"
Exit Sub
Else
UserForm1.Image1.Picture = pic
UserForm1.Show
End If
End Sub
'

------------------------------------------------------------------
Masaru Kaji (aka Colo) Office Systems - Excel MSMVP(2004-2005)

Web site: Colo's Excel Junk Room
http://www.interq.or.jp/sun/puremis/colo/

Email: (e-mail address removed)