Discussion :

[jérémy39700]

Bonjour à tous,
Je suis novice pour tout ce qui est macro, VB...
Je suis actuellement en Master de sport et je suis en train de créer un petit programme sur EXCEL qui me permettrait de créer des séances de musculation pour une equipe de handball (ce qui me fera gagner un temps énorme).

Mais je me heurte à un problème, Je galère à créer plusieurs listes déroulantes dans la même feuille me permettant de choisir un exercice de musculation (en fonction du le nom) et me donnant dans une autre cellule l'image qui y fait référence.

Par exemple, pour l'exercice SQUAT(choisit dans le menu déroulant) je voudrais avoir dans une autre cellule l'image correspondant.

Bon on va dire que réaliser une seul liste déroulante avec son image, j'y arrive un peu près, mais le problème et que je voudrais plusieurs listes déroulantes sur la même feuille et donc plusieurs emplacements pour mes images qui seront bien entendu différentes des autres :S.
J'ai été assez claire??

J'ai trop besoin de votre aide, je ne dors plus !!

[jérémy39700]

Personne?

SVP je voudrais telement réussir à faire ce programme :S

Comme je vous l'ai dit j'ai réussi a faire en sorte d'avoir une image en fonction d'une liste mais je sais pas comment faire pour avoir deux ou plusieurs listes déroulante avec image:S

Je vous donne ce que j'ai déja :

Une macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub EffacePhoto()
Dim sh As Object
For Each sh In Sheets("vierge").Shapes
If Left(sh.Name, 3) = "Img" Then sh.Delete
Next sh
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Public Function ExisteGIF(Image As String) As Boolean
Dim tatiak As Object
Set tatiak = CreateObject("Scripting.FileSystemObject")
ExisteGIF = tatiak.FileExists(Image)
End Function

Et voici la code de la feuille nommé "vierge" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Image As String, LargeurImage As Single, Gauche As Single
Dim sh As Shape, tatiak As Object
If Not Intersect(Target, Range("F2")) Is Nothing Then
Call EffacePhoto
Image = ActiveWorkbook.Path & "\" & Target.Text & ".gif"
If Not ExisteGIF(Image) Then Image = ActiveWorkbook.Path & "\" & Target.Text & ".JPG"
If Not ExisteGIF(Image) Then Image = ActiveWorkbook.Path & "\" & Target.Text & ".BMP"
If Not ExisteGIF(Image) Then Image = ActiveWorkbook.Path & "\PasImage.GIF"
If ExisteGIF(Image) Then
Set tatiak = Sheets("vierge").Pictures.Insert(Image)
With Range("vierge!F1")
LargeurImage = (tatiak.Width * .Height / tatiak.Height) * 0.9
Gauche = .Left + (.Offset(0, 1).Left - .Left - LargeurImage) / 2
tatiak.Delete
Set sh = Sheets("vierge").Shapes.AddShape(msoShapeRectangle, _
Gauche, .Top, .Width, .Height)
sh.Name = "Img" & .Value
sh.Fill.UserPicture Image
sh.Height = .Height * 0.9
sh.Width = LargeurImage
End With
End If
End If
End Sub

Donc voila pour mon image avec la liste déroulante se trouvant en F2 et mon image en F1



J'ai vraiment besoin d'ête svp :S!!!!!!

Merci d'avance

[mercatog]

J'ai légèrement modifié ton code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Private Sub EffacePhoto(rng As Range)
Dim Sh As Shape
 
For Each Sh In Sheets("vierge").Shapes
    If Left(Sh.Name, 7) = "Img" & Format(rng.Row - 1, "00") & Format(rng.Column, "00") Then
        Sh.Delete
        Exit Sub
    End If
Next Sh
End Sub
 
Private Function ExisteGIF(Image As String) As Boolean
Dim Tatiak As Object
 
Set Tatiak = CreateObject("Scripting.FileSystemObject")
ExisteGIF = Tatiak.FileExists(Image)
Set Tatiak = Nothing
End Function
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Image As String, LargeurImage As Single, Gauche As Single
Dim Sh As Shape, Tatiak As Object
Dim ImExt
Dim i As Byte
Dim OK As Boolean
 
ImExt = Array(".gif", ".bmp", ".jpg")
If InStr("F2|G2|H2", Target.Address(0, 0)) > 0 Then        'mettre ici toutes les adresses de tes listes
    If Target.Value <> "" Then
        Call EffacePhoto(Target)
        For i = 0 To 3
            Image = ThisWorkbook.Path & "\" & Target.Text & ImExt(i)
            If ExisteGIF(Image) Then
                OK = True
                Exit For
            End If
        Next i
        If OK Then
            With Target.Offset(-1, 0)
                Set Tatiak = ActiveSheet.Pictures.Insert(Image)
                LargeurImage = (Tatiak.Width * .Height / Tatiak.Height) * 0.9
                Tatiak.Delete
                Set Tatiak = Nothing
                Gauche = .Left + (.Offset(0, 1).Left - .Left - LargeurImage) / 2
                Set Sh = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Gauche, .Top, .Width, .Height)
                'Le nom est désormais ImgXXYYzzzz, XX Ligne, YY colonne et zzzz valeur
                Sh.Name = "Img" & Format(.Row, "00") & Format(.Column, "00") & .Value
                Sh.Fill.UserPicture Image
                Sh.Height = .Height * 0.9
                Sh.Width = LargeurImage
                Set Sh = Nothing
            End With
        End If
    End If
End If
End Sub