Ou stocker des images pour les utiliser dans un USERFORM?

Version imprimable

07/11/2013, 15h51
ThamAL

Ou stocker des images pour les utiliser dans un USERFORM?

Bonjour à tous,

J'ai besoin d'un Userform qui afficherait l'image de l'article choisi en fonction
des contrôles utilisés.

Je sais faire quand j'utilise des images stocker dans un répertoire.

Par contre je souhaierai que le fichier soit indépendant et donc stocker les images sur une feuille.

J'ai collé 10 vignettes dans une page mais je ne trouve pas comment les récupérer dans l'Userform....

Auriez-vous une idée?
Ou peu-être ce n'est tout simplement pas possible...

Merci de votre aide

Tham
07/11/2013, 15h57
EngueEngue

Tu connais imagelist ?

http://silkyroad.developpez.com/VBA/ImageList/
07/11/2013, 16h29
ThamAL

Merci EnqueEnque,

Non en effet je connaissais pas ce contrôle complémentaire.

Je regarderai ça en détail mais effectivement cela doit répondre à mon besoin.

Par contre je me pose une question,
Si j'envoie un fichier utilisant un contrôle complémentaire que l'utilisateur n'a pas dans sa version Excel, est ce que cela va fonctionner ou alors il doit l'installer en pre-requis?

Merci
07/11/2013, 16h31
EngueEngue

Bonne question. A laquelle je ne saurais répondre.

Si tu actives la référence dans ton classeur elle le suivra à moins que l'utilisateur ait une version "chelou" d'excel.
07/11/2013, 16h42
ThamAL

Ok je testerai,

par contre je ne sais pas si finalement cela répond à mon besoin car je n'arrive toujours pas à récupérer l'image stockée sur une feuille Excel...

Une idée?

Merci

C'est la galère....

Voilà ça marche...
Module standard

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub SavePictureAs(strPicName As String, ByVal strFile As String, strFormat As String)
 
Dim wsTemp As Worksheet, chtObj As Chart, pObj As Picture
Dim dblWidth As Double, dblHeight As Double
 
ActiveSheet.Shapes(strPicName).Select
Set pObj = Selection
dblWidth = pObj.Width: dblHeight = pObj.Height: pObj.Copy
 
Application.ScreenUpdating = False
 
Set chtObj = Charts.Add: Set wsTemp = Sheets.Add
chtObj.Location Where:=xlLocationAsObject, Name:=wsTemp.Name
wsTemp.Range("A1").Select
 
With wsTemp.ChartObjects(1)
     .Top = 0
     .Left = 0
     .Width = dblWidth
     .Height = dblHeight
     .Activate
     .Chart.Paste
     .Interior.ColorIndex = 1
     .Chart.Export Filename:=strFile, FilterName:=strFormat
End With
 
Application.DisplayAlerts = False: wsTemp.Delete
Application.DisplayAlerts = True: Application.ScreenUpdating = True
 
End Sub

Userform:

Code:

1
2
3
4
5
Private Sub UserForm_Initialize()
Fname = ThisWorkbook.Path & Application.PathSeparator & "temp.gif"
SavePictureAs "Image 1", Fname, "GIF"
UserForm1.Image1.Picture = LoadPicture(Fname)
End Sub

Et si le temps de latence ne te plait pas... Désolé mon gars, this is not possible.

Bonjour,

Essayez la piste suivante où les images sont stockées dans un second UserForm
1) Créez un UserForm1 avec une Image1, un Label1, un Label2
2) Copiez le code suivant dans la fenêtre de code du UserForm1
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Private Sub Label1_Click() Dim MonImage As MSForms.Image Dim i& i& = CLng(Me.Label1.Caption) i& = i& + 1 If i& > UserForm2.Controls.Count Then i& = 1 Me.Label1.Caption = i& Set MonImage = UserForm2.Controls(i& - 1) Me.Image1.Picture = MonImage.Picture End Sub Private Sub UserForm_Initialize() With Me .Label1.Caption = 1 .Label1.BackColor = &HC0FFFF '--- .Label2.Caption = "Cliquez la zone jaune pour faire défiler" '--- .Image1.Picture = UserForm2.Image1.Picture End With End Sub
3) Créez un UserForm2 avec plusieurs contrôles Image (surtout pas d'autre contrôle), ce sera le conteneur d'images
4) Par le biais de la propriété Picture, chargez les images désirées
A noter : aucun code n'est présent dans ce UserForm2

Adaptez ou faites évoluer selon votre besoin.
Je mets le classeur exemple en pièce jointe pour faciliter.

07/11/2013, 22h06
EngueEngue

Malinx le linx! Encore merci pour tes astuces légendaires, les miennes pâlissent à coté.
08/11/2013, 10h32
grisan29

bonjour PM02017, EngueEngue et le forum

PM02017 le lien du fichier ne peux pas etre ouvert chez moi voici un apercu
http://cjoint.com/?CKikDTrPcSz de la raison

mais une fois recréer les usf grâce au code donné c'est magnifique le fonctionnement
Merci pour cette solution que je garde très précieusement

Pascal
08/11/2013, 10h59
PMO2017

@ grisan29

Citation:

PM02017 le lien du fichier ne peux pas être ouvert chez moi

Bonjour,

Pour pouvoir m'y retrouver dans mes archives, je nomme mes classeurs avec un nom très explicite (en l'occurrence : "Stocker des images dans un UserForm conteneur pour les utiliser dans un UserForm maître.xlsm") qui peut être très long. Par la suite, je zippe le classeur pour pouvoir le mettre en pièce jointe.

Si, après l'avoir téléchargé, vous l'ouvrez directement à partir du .zip cela fait tilt car le nom du fichier est trop long (Office ne s'y retrouve pas).
En revanche, si vous le dézipper au préalable (en faisant glisser/déposer le fichier du .zip sur le bureau) et que vous ouvrez le classeur à partir du bureau, il n'y a plus de problème du moins chez moi.
Faites la démarche et tenez moi au courant du résultat.

Bonne journée et à plus.

1 pièce(s) jointe(s)

Bonjour,

cf exemple en PJ

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Dim f
Private Sub UserForm_Initialize()
  Set f = Sheets("photos")
  For Each s In f.Shapes
    Me.ComboBox1.AddItem s.Name
  Next
End Sub
 
Private Sub ComboBox1_Change()
  Set s = f.Shapes(CStr(Me.ComboBox1))
  s.CopyPicture
  f.ChartObjects.Add(0, 0, s.Width, s.Height).Chart.Paste
  f.ChartObjects(1).Chart.Export Filename:="monimage.jpg"
  f.Shapes(f.Shapes.Count).Delete
  Me.Image1.PictureSizeMode = fmPictureSizeModeZoom
  Me.Image1.Picture = LoadPicture("monimage.jpg")
  Kill "monimage.jpg"
End Sub

Jacques Boisgontier

08/11/2013, 20h30
grisan29

bonsoir PM02017
je ne pensais pas te vexé :? mais le fait de mettre le fichier sur le bureau comme tu l'a dit est parfait:ccool: et je peux l'ouvrir, c'est un très beau fichier :ccool:que je vais garder pour plus tard8-)

boisgontierjacques: ton fichier est très bien :ccool:et je vais le conserver également

Pascal
08/11/2013, 20h55
PMO2017

@ grisan29

Citation:

bonsoir PM02017
je ne pensais pas te vexé

Je ne suis pas du tout vexé.
Si quelque chose, dans le corps de mon message, a pu t'inciter à le croire alors je te prie de m'en excuser.
Bonne soirée et à plus.