picture to userform

Jaye7

Well-known Member
Joined
Jul 7, 2010
Messages
1,069
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

Code:
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

Code:
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
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
have you set

Image1.picturesizemode=3 (zoom)
 
Upvote 0
you seem to have a lot of code to do something that should be simple. can you load the pic from file? this takes 1 line of code and its all good.

Code:
    if dir("MyPictureSource") <> "" then Image1.picture = loadpicture(MyPicture.jpg)
 
Upvote 0
Hi Diddi,

I have tried adjusting the zoom but it remains the same.

I actually just want to load the image to the image1.box so that my lable1 can be the image1.picture however I see when I use it that it loads to the userform even though the code shows it as loading to image1.
 
Upvote 0
I wanted to load the pics from the worksheet and I use various different computers and didn't want to have to create folders and then copy the pictures from the worksheet to the folders and tehn have to delete the folders upon exit (using script of course), it's just plain slow if you have numerous images.
 
Upvote 0
if you have a set of images that doesnt change, you can leave them all on the userform but set .visible = false for each.

then just show the image you want.


with the zoom - i dont mean screen zoom, i mean the .picturesizemode property
 
Upvote 0
Hi Diddy,

The picture mode was what I was trying to adjust but it didn't work.

Can you please advise how I can I save pictures to the userform, as the pictures link to a folder so if the folder doesn't exist then the picture won't be shown (my understanding of pics).

I want various staff to be able to use the workbook but I don't want pictures being saved to their drives and we are not networked so I can't dump the pics in a generic folder.
 
Upvote 0
PM me your email. i have a demo for you.
 
Upvote 0
PM me your email. i have a demo for you.
 
Upvote 0

Forum statistics

Threads
1,224,585
Messages
6,179,703
Members
452,938
Latest member
babeneker

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top