picture to userform

[Jaye7]

Hi All,

I have the following code which loads a picture from my sheet into the userform, the problem that I am having is it resizes the userform to the image size and I don't want this to happen, I want the userform to remain as 500 x500.

Also I need a script to load the image1.pic into label1

the code follows.

the userform code is

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(20) 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 As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData& Lib "user32" (ByVal wFormat%)
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
 
Private Sub UserForm_Initialize()
ImageToMePicture
'UserForm1.Height = Image1.Height
'UserForm1.Width = Image1.Width
UserForm1.Height = 500
UserForm1.Width = 500
End Sub
Private Sub ImageToMePicture()
'actualisation
Selection.CopyPicture xlScreen, xlBitmap
Dim hCopy&: OpenClipboard 0&
hCopy = CopyImage(GetClipboardData(2), 0, 0, 0, &H4)
CloseClipboard: If hCopy = 0 Then Exit Sub
Const IPictureIID = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"
Dim IPic As IPicture, tIID As GUID, tPICTDEST As PICTDESC
If IIDFromString(StrConv(IPictureIID, vbUnicode), tIID) Then Exit Sub
With tPICTDEST
.cbSize = Len(tPICTDEST)
.picType = 1
.hImage = hCopy
End With
If OleCreatePictureIndirect(tPICTDEST, tIID, 1, IPic) Then Exit Sub
Me.Image1.Picture = LoadPicture("")
Me.Image1.Picture = IPic
Set IPic = Nothing
ClearClipboard
End Sub
Private Sub ClearClipboard()
OpenClipboard 0&
EmptyClipboard
CloseClipboard
End Sub

the module code follows

Private Sub Bouton_Userform()
UserForm1.Show vbModeless
End Sub
Sub Run_Pic()
'pic number will show in top left formula bar corner when you click on it
 
    ActiveSheet.Shapes("Picture 11").Select
    Application.Run "'load pic to imagebox.xls'!Bouton_Userform"
End Sub

 

[diddi]

done

 

[Jaye7]

Thanks Diddi, that's great, will come in handy.