PDA

View Full Version : [SOLVED] appear pictures in userform



MARTI MARTI
06-23-2015, 06:49 AM
13769

hello to all
I hope that I find helps me to solve my only problem ..
in this file i have two userform.
UserForm1 controletype that contains text and when I click over any picture will appear the second userform containing information for these films after the base given dieters ..
I just want to display the pictures that are in the base sheet data (DATABASE) in userform 2 .. please look at this picture and the file ..
thank you in advance for help
cordially
MARTI
13771
13770

MARTI MARTI
06-23-2015, 09:22 AM
Hello forum..
I need your help please
cordially
:banghead:M:banghead:A:banghead:R:banghead:T:banghead:I:banghead:

Kenneth Hobs
06-23-2015, 09:32 AM
You have attached an invalid file type somehow. Click the Go Advanced button in lower right of a reply and then the paperclip icon on the toolbar to attach the Excel or ZIP file.

MARTI MARTI
06-23-2015, 12:25 PM
Hello
this is the file
thank you in advance
cordially
MARTI
13773
13774

MARTI MARTI
06-24-2015, 10:08 AM
hiiiii
:banghead::devil2::dunno
cordially
MARTI

Kenneth Hobs
06-24-2015, 05:44 PM
I am wondering if your file path exists from Module 2:

.Controls("Image" & i).Picture = LoadPicture("J:\Jaquettes\" & liste(i) & ".jpg") 'chargement de l'image
You can use Debug.Print to output during a run to the Immediate window.
e.g. After that line:

Debug.print "J:\Jaquettes\" & liste(i) & ".jpg", Len(Dir("J:\Jaquettes\" & liste(i) & ".jpg"))<>0

Or, were you wanting code to create the JPG's for you?

MARTI MARTI
06-24-2015, 06:39 PM
Hiii KENNETH HOBS
thank you in advance for help me
I want to stay all picture in the sheet (DATABASE)..
codially
MARTI

SamT
06-25-2015, 05:18 AM
I don't reply to PMed questions :(

Aflatoon
06-25-2015, 05:23 AM
Well, you do, but probably not in the manner the OP hoped. ;)

SamT
06-25-2015, 05:57 AM
First I banned him. Then I sipped my coffee and saw that he already had some response, so I unbanned him so as not to inconvenience our regulars.

Not to say that I might not have unbanned him anyway after coffee I know how I am before the caffeine hits the brain stem. :boxer:

MARTI MARTI
06-25-2015, 06:35 AM
First I banned him. Then I sipped my coffee and saw that he already had some response, so I unbanned him so as not to inconvenience our regulars.

Not to say that I might not have unbanned him anyway after coffee I know how I am before the caffeine hits the brain stem. :boxer:

Hiiiii SamT


Then .. good day
:dau::dau::dau::dau::dau::dau:

MARTI MARTI
06-25-2015, 06:37 AM
Well, you do, but probably not in the manner the OP hoped. ;)

:banghead::banghead::banghead:

Aflatoon
06-25-2015, 07:37 AM
FYI, I find your question pretty unclear. There's no code to speak of in either form so I'm not sure whether you are asking for help with a specific problem or for someone to just make this all work for you.

Kenneth Hobs
06-25-2015, 08:29 AM
I think the unclearness is due to a language barrier.

The code is in the Module, and the Class in his attachment.

I will post something later today. I have a big part of it done. If you see what was done, and how I will help, I think it might be interesting for some.

Aflatoon
06-25-2015, 08:50 AM
Having looked at that I think my confusion was more down to the fact the OP asked about populating userform2 with pictures from the sheet. I think he meant UF1. That's also a slightly unusual way of using a class with a userform - typically the class instances would be held in the form.

MARTI MARTI
06-25-2015, 08:58 AM
Having looked at that I think my confusion was more down to the fact the OP asked about populating userform2 with pictures from the sheet. I think he meant UF1. That's also a slightly unusual way of using a class with a userform - typically the class instances would be held in the form.
hiiii Aflatoon
I did not understand what you say .. I am newbie in vba language .. and I'm also beginner in English language .. my desire is clear .. thank you in advance for the help .. thank you in advance for any proposition
cordially
MARTI

Kenneth Hobs
06-25-2015, 12:16 PM
I changed your shape names to be consecutive. You did not have an "Image 3".

The attached file will do it but it is not optimal. It is all that I have time for right now. The easiest method to set the image dimensions might be to save the shape with the image control's dimensions for userform1 and then another for userform2's image control dimensions. Scaling can be a problem for images though. If you have irfanview, there is a knowledge base (kb) entry that explains how you can use it to set image dimensions.

For those that don't want to open the file, here is some code to give you an idea of what the file has.
Module2 modified:

Public liste As Range
Dim IM() As New Classe1


Sub affiche()
'Feuil2 est le CodeName de la feuille
Dim i%
Set liste = Feuil2.Range("B3:B" & Application.Match("zzz", Feuil2.[B:B]))
If liste.Row = 1 Then Exit Sub
ReDim IM(liste.Count)
On Error Resume Next 'si une photo ou un contrôle n'existent pas
With UserForm1
For i = 1 To liste.Count
If liste(i) <> "" Then
Set IM(i).IM = .Controls("Image" & i)
'.Controls("Image" & i).Picture = LoadPicture("J:\Jaquettes\" & liste(i) & ".jpg") 'chargement de l'image
'.PictureSizeMode = 3 ' 0=partiel, 1 = étirer, 3= proportionnel
End If
Next
.Show
End With
End Sub
Added mShapeToImage Module:

'Modified by Kenneth Hobson, 6/25/15, based on: http://www.mrexcel.com/forum/showthread.php?t=562721
'Declare a UDT to store a GUID for the IPicture OLE Interface
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

'Declare a UDT to store the bitmap information
Public Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

Public Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long

Public Declare Function GetClipboardData Lib "user32" _
(ByVal wFormat As Integer) As Long


Public Declare Function EmptyClipboard Lib "user32" () As Long

Public Declare Function CloseClipboard Lib "user32" _
() As Long

Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, _
RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long

Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const PICTYPE_BITMAP = 1

Sub Shape_to_Image(oShape As Shape, oImage As Image, Optional sFileName As String = "")

Dim IID_IDispatch As GUID
Dim uPicinfo As uPicDesc
Dim IPic As IPicture
Dim hPtr As Long
'Dim sTempFileName As String

'sTempFileName = ThisWorkbook.Path & "\temp.bmp"

'Copy and retrieve the handle to the range Image
oShape.CopyPicture xlScreen, xlBitmap
OpenClipboard 0
hPtr = GetClipboardData(CF_BITMAP)
CloseClipboard

'Create the interface GUID for the picture
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With

' Fill uPicInfo with necessary parts.
With uPicinfo
.Size = Len(uPicinfo) ' Length of structure.
.Type = PICTYPE_BITMAP ' Type of Picture
.hPic = hPtr ' Handle to image.
.hPal = 0 ' Handle to palette (if bitmap).
End With

'Create the Picture Object
OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic

'oImage.Picture = ""
oImage.Picture = IPic

'Save Picture Object to disk.
If sFileName = "" Then sFileName = ThisWorkbook.Path & "\temp.bmp"
stdole.SavePicture IPic, sFileName

'Comment.Shape.Fill.UserPicture sTempFileName
End Sub




Initialize event added to Userform1:

Private Sub CommandButton1_Click() Unload Me
End Sub


' WIA, https://msdn.microsoft.com/en-us/library/windows/desktop/ee663303(v=vs.85).aspx
' Using WIA Filters, http://msdn.microsoft.com/en-us/library/ms630819%28VS.85%29.aspx
' Early binding requires Tools > References > Microsoft Windows Image Acquisition Library v2.0
' c:\windows\system32\wiaaut.dll
' WIA method to get height, width and such, are read only properties.


Private Sub UserForm_Initialize()
Dim i As Integer, fn As String

On Error Resume Next
For i = 1 To 8
fn = ThisWorkbook.Path & "\Image " & i & ".bmp"
Shape_to_Image Worksheets("DATABASE").Shapes("Image " & i), Me.Controls("Image" & i), fn
Me.Controls("Image" & i).Picture = LoadPicture(fn)
Next i
End Sub
No change to Classe1:

Option ExplicitPublic WithEvents IM As MSForms.Image


Private Sub IM_Click()
Dim i%, j As Byte
i = Val(Replace(IM.Name, "Image", ""))
For j = 1 To 12
UserForm2.Controls("TextBox" & j) = Feuil2.Cells(i + 2, j).Text
Next
UserForm2.Image1.Picture = UserForm1.Controls("Image" & i).Picture
UserForm1.Hide
UserForm2.Show
End Sub


Private Sub IM_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim i%
With UserForm1.TextBox1
.Visible = False
If X > 10 And X < IM.Width - 10 And Y > 10 And Y < IM.Height - 10 Then
i = Val(Replace(IM.Name, "Image", ""))
.AutoSize = False
.Value = Join(Array(liste(i), liste(i, 2), liste(i, 3), liste(i, 4), _
liste(i, 5), liste(i, 8), liste(i, 9), liste(i, 10), liste(i, 11)), vbLf)
.Width = 1000
.AutoSize = True
.Width = .Width + 5
.Left = X + IM.Left - .Width / 2
If .Left < 0 Then .Left = 0
If .Left + .Width > .Parent.Width Then .Left = .Parent.Width - .Width
.Top = Y + IM.Top + 10
.Visible = True
End If
End With
End Sub

MARTI MARTI
06-25-2015, 12:34 PM
Hiii Kenneth hobs
it's really what I want
thank you for help
thank you for your precious sacred time to solve my problem
finally..thank you for all
it is resolved
cordially
MARTI