Discussion :

[Baptiste3687]

Bonjour,

Je suis en train de crée un fichier avec une inputbox et une userform. Je suis vraiment débutant dans ce domaine de macro et de VBA mais j'ai quand même réussit à effectuer quelque manipulation grâce aux codes que j'avais sur internet.
Je vous explique mon projet. Cependant pour des raison de confidentialité je vais utiliser des titres bidons.

J'ai crée une userbox avec une liste déroulante modifiable et trois checkbox à coter. La liste déroulante est automatiquement remplit grace a un lien avec des cellules. Admettons que dans ma liste déroulante il y ai 10 noms de pommes.
Je veut que lorsque je clic par exemple sur la pomme 1 dans la liste, je puisse cocher, si elle est verte et/ou si elle est rouge et/ou si elle bleu mais que pour la pomme 2 les cases reviennent viergent pour que je puisse les remplir. J'aimerai aussi que pour chaque pomme, mes choix avec les checkbox soit sauvergarder.

Enfin je voudrais pouvoir enregistrer ma userbox pour que lorsqu'un autre utilisateur qui ouvre le fichier excel, il puisse visualiser ma userbox et si il souhaite, la modifier.

Voila le code que j'ai pour l'instant.

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
Private Sub UserForm1_Initialize()
Dim i
    For i = 1 To 10
        ComboBox1.AddItem Sheets("Feuil1").Cells(i, 1)
    Next
End Sub
 
Private Sub ComboBox1_Change()
 
 [A1] = UserForm1.ComboBox1
 
 
End Sub
Private Sub Verte_Click()
 
End Sub
 
Private Sub Rouge_Click()
 
End Sub
Private Sub Bleu_Click()
 
End Sub
 
Private Sub Valider_Click()
UserForm1.Hide
End Sub

Merci beaucoup pour votre aide.

[keygen08]

Bonjour

Voici de quoi passer le temps
Je mets en fichier joints par gain de temps.

[lucasgaetan]

Bonjour Baptiste

Je veut que lorsque je clic par exemple sur la pomme 1 dans la liste, je puisse cocher, si elle est verte et/ou si elle est rouge et/ou si elle bleu

pour cela je te conseille de mettre des bouton d'option (OptionButton un rond à "cocher") dans un cadre (ou Frame) --> si tu coche l'option 1 l'autre se decoche

mais que pour la pomme 2 les cases reviennent viergent

il faut donc réinitialisé tes bouton d'option lorsque tu modifie ton choi liste déroulante (dans l'exemple "ComboBox1")

Code :

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

1
2
3
4
5
6
Private Sub ComboBox1_Change()
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = False
.......
End Sub

---> je ne te prend pas la tète avec le scan des objets dans une UserFormes (For Each Object in me ....)

J'aimerai aussi que pour chaque pomme, mes choix avec les checkbox soit sauvergarder.

pour cela, il faut te créer une base de données (dans une feuille de ton classeur par exemple "Feuil3")
ligne 1 = pomme 1 avec colonne A nom de la pomme colonne B couleur de la pomme
ligne 2 = pomme 2 avec colonne A nom de la pomme colonne B couleur de la pomme
....
et un bouton sauvegarder (CommandButton1 pour l'exemple)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub CommandButton1_Click()
    Select Case ComboBox1.Value
        Case "pomme 1"
            Sheet("Feuil3").Range("A1").Value = ComboBox1.Value
            Sheet("Feuil3").Range("B1").Value = OptionButton1.Caption
        Case "pomme 2"
            Sheet("Feuil3").Range("A2").Value = ComboBox1.Value
            Sheet("Feuil3").Range("B2").Value = OptionButton1.Caption
        'ect.......
    End Select
End Sub

--> idem je te laisse gérer les boucle suivant ton niveau en vba

Enfin je voudrais pouvoir enregistrer ma userbox pour que lorsqu'un autre utilisateur qui ouvre le fichier excel, il puisse visualiser ma userbox et si il souhaite, la modifier.

Je prends ca pour "je veux pouvoir lire se que j'ai enregistré"

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub ComboBox1_Change()
'Mettre à la suite du code précedent : OptionButton1.Value = False .......
    Select Case ComboBox1.Value
        Case "pomme 1"
             OptionButton1.Caption = Sheet("Feuil3").Range("B1").Value
        Case "pomme 2"
             OptionButton2.Caption = Sheet("Feuil3").Range("B1").Value
        'ect.......
    End Select
End Sub

--> ce code ne marche pas, il faut que tu t’intéresse au scan des objets dans une UserFormes sinon ça devient vraiment compliquer
AUTREMENT tu trouve un code à toi

bon courage.
ceci n'ai pas ta solution, je n'ai fait que te donner que des pistes, à toi de les explorer

[Baptiste3687]

Bonsoir,

Désolé d'avoir mis du temps à vous répondre mais je n'ai pas trop eu le temps ces derniers temps à cause de mes études.

Je tient déjà à vous remercier pour le temps que vous avez consacrez pour me répondre. Cependant j'arrive pas a remplir ma listbox a partir de données présentes dans plusieurs cellules d'une seule colonne. Ensuite la méthode de keygen08 me convient bien. Mais je n'arrive pas à la rentrer dans ma feuille. Rien ne se passe. Si vous pouviez m'aidez pas à pas, car étant débutant dans la VBA, je ne comprend pas grand chose.

Merci beaucoup.

[Theze]

Bonjour,

Un code assez simple. Les valeurs sont stockées dans la colonne B de B1 à B4 et la plage de la combobox en colonne A de A1 à A... :

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
 
Private Sub UserForm_Initialize()
 
    With Worksheets("Feuil1")
 
         ComboBox1.RowSource = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Address
 
    End With
 
    ComboBox1.Text = Range("B1").Value
 
    'si des valeurs ont été mémorisées dans un choix précédant
    If Range("B2").Value <> "" Then
 
        Verte.Value = Range("B2").Value
        Rouge.Value = Range("B3").Value
        Bleu.Value = Range("B4").Value
 
    End If
 
End Sub
 
Private Sub ComboBox1_Click()
 
    Verte.Value = 0
    Rouge.Value = 0
    Bleu.Value = 0
 
End Sub
 
Private Sub Valider_Click()
 
    'sauvegarde en colonne B
    Range("B1").Value = ComboBox1.Text
    Range("B2").Value = CInt(Verte.Value)
    Range("B3").Value = CInt(Rouge.Value)
    Range("B4").Value = CInt(Bleu.Value)
 
    Unload Me
 
End Sub

Hervé.

[Baptiste3687]

Bonjour,

Merci Hervé pour ton aide. J'ai tout arrivé à faire, sauf que quand je coche les checkbox, les cases ne se remplissent pas en marquant la couleur de la pomme pour sauvegarder mon choix comme me l'as montrer keygen08.

Merci

[keygen08]

Bonsoir
Tu nous en dirais un peu plus, on pourrai peut etre aider.
Nous ne sommes pas des devins.
Quel solution a tu retenu, quel code a tu developpé, ou sont tes donné sur ta feuille.
Tes couleur sont t-elle concatener comme dans l'ex que je t'ai donné ou bien chacun sa colonne.
As tu cherché comment je faisais pour faire la meme chose.
Aider oui, mais on ne peut faire a ta place un projet dont tu est le seul a connaitre les tenants et abouttisants.

[Baptiste3687]

Bonsoir,


Voici mon 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
Private Sub UserForm_Initialize()
 
    With Worksheets("Ordre_du_jour")
 
         ListBox1.RowSource = .Range(.Cells(7, 21), .Cells(.Rows.Count, 21).End(xlUp)).Address
 
    End With
 
    ListBox1 = Range("Z1").Value
 
    'si des valeurs ont été mémorisées dans un choix précédant
    If Range("q2").Value <> "" Then
 
        IBN.Value = Range("q2").Value
        Réception.Value = Range("q3").Value
        Série.Value = Range("q4").Value
 
    End If
 
End Sub
 
Private Sub ListBox1_Click()
 
    Verte.Value = 0
    Bleu.Value = 0
    Rouge.Value = 0
 
End Sub
 
Private Sub Valider_Click()
 
    'sauvegarde en colonne B
    Range("q2").Value = (Verte.Value)
    Range("q3").Value = (Bleu.Value)
    Range("q4").Value = (Rouge.Value)
 
    Unload Me
 
End Sub

Là je voudrai que le nom verte bleu et/ou rouge soit marquer si possible tout les trois ou une seule couleurs ou deux ou trois dans une seule cellule mais en fontion du numéro de la pomme. Exactement comme dans ton exemple Keygen08.

je met en pièce jointe une copie de mon écran pour que vous ayez les cellules.

Sinon explique moi ton code car je ne l'ai pas du tout compris. Pourtant il me convenais parfaitement.

[Theze]

Bonjour,

Je ne sais pas vraiment si c'est ce que tu veux ?

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
 
Private Sub UserForm_Initialize()
 
    With Worksheets("Ordre_du_jour")
 
         ListBox1.RowSource = .Range(.Cells(7, 21), .Cells(.Rows.Count, 21).End(xlUp)).Address
 
    End With
 
    ListBox1 = Range("Z1").Value
 
    'si des valeurs ont été mémorisées dans un choix précédant
    Verte.Value = IIf(Range("Q2").Value = "Verte", True, False)
    Bleu.Value = IIf(Range("Q3").Value = "Bleu", True, False)
    Rouge.Value = IIf(Range("Q4").Value = "Rouge", True, False)
 
'    IBN.Value = Range("Q2").Value
'    Réception.Value = Range("Q3").Value
'    Série.Value = Range("Q4").Value
 
End Sub
 
Private Sub ListBox1_Click()
 
    Verte.Value = False
    Bleu.Value = False
    Rouge.Value = False
 
End Sub
 
Private Sub Valider_Click()
 
    'sauvegarde en colonne Q
    Range("Q2").Value = Choose(Verte.Value + 2, "Verte", "")
    Range("Q3").Value = Choose(Bleu.Value + 2, "Bleu", "")
    Range("Q4").Value = Choose(Rouge.Value + 2, "Rouge", "")
 
    Range("Z1").Value = ListBox1.Text
 
    Unload Me
 
End Sub

Hervé.

[keygen08]

Bonjour

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
57
58
59
60
61
62
Private Sub UserForm_Initialize()
ListBox1.RowSource = "a2:a" & Cells(Cells.Rows.Count, 1).End(xlUp).Row
End Sub
 
Private Sub CheckBox0_click()
Call coche
End Sub
Private Sub CheckBox1_click()
Call coche
End Sub
Private Sub CheckBox2_click()
Call coche
End Sub
 
Private Sub ListBox1_change()
Dim j As Integer, i As Integer
Dim ArrWd
'decoche les checkbox
        CheckBox0 = False
        CheckBox1 = False
        CheckBox2 = False
 
'On  passe en revue tous les elements pour savoir lequel est selectionner
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
    Set r = Feuil4.Columns(1).Find(ListBox1.List(i))
    'si selectionner, recherche l'element dans la feuille pour n'en retenir que le contenu
        If Not r.Offset(0, 1) = "" Then 'si pas de contenu, on sors, gain de temps
        ArrWd = Split(Cells(r.Row, 2), " ") 'si contenu<>"", on le place dans un tableau et on le decoupe
            For j = 0 To UBound(ArrWd) 'on analyse pour chaque decoupe s'il correspond a un chekbox
                If UserForm1.CheckBox0.Caption = ArrWd(j) Then UserForm1.CheckBox0 = True 'auquel cas on coche
                If UserForm1.CheckBox1.Caption = ArrWd(j) Then UserForm1.CheckBox1 = True
                If UserForm1.CheckBox2.Caption = ArrWd(j) Then UserForm1.CheckBox2 = True
            Next j
            Exit For 'sortie de routine, gain de temps
        End If
        Exit For
    End If
Next i
End Sub
Sub coche()
Dim r As Range
Dim i As Integer
'On  passe en revue tous les elements pour savoir lequel est selectionner
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
    'si selectionner, recherche l'element dans la feuille pour n'en retenir que l'ordonné(ligne)
    Set r = Feuil4.Columns(1).Find(ListBox1.List(i))
'        passe en revue les trois checkbox
        For j = 0 To 2
'            si croix dans checkbox
            If UserForm1.Controls("CheckBox" & j) = True Then
'            met la couleur en memoire
            temp = temp & " " & UserForm1.Controls("CheckBox" & j).Caption
            End If
        Next j
    'recupere la valeurs mis en memoire pour la coller sur la feuille
    Cells(r.Row, 2) = temp
    Exit For
    End If
Next i
End Sub

Voici le code commenter, apres test, j'ai changer quelques lignes par rapport au fichier que j'ai envoyé. (nul n'est parfait)

[Baptiste3687]

Bonjour

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
57
58
59
60
61
62
Private Sub UserForm_Initialize()
ListBox1.RowSource = "a2:a" & Cells(Cells.Rows.Count, 1).End(xlUp).Row
End Sub
 
Private Sub CheckBox0_click()
Call coche
End Sub
Private Sub CheckBox1_click()
Call coche
End Sub
Private Sub CheckBox2_click()
Call coche
End Sub
 
Private Sub ListBox1_change()
Dim j As Integer, i As Integer
Dim ArrWd
'decoche les checkbox
        CheckBox0 = False
        CheckBox1 = False
        CheckBox2 = False
 
'On  passe en revue tous les elements pour savoir lequel est selectionner
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
    Set r = Feuil4.Columns(1).Find(ListBox1.List(i))
    'si selectionner, recherche l'element dans la feuille pour n'en retenir que le contenu
        If Not r.Offset(0, 1) = "" Then 'si pas de contenu, on sors, gain de temps
        ArrWd = Split(Cells(r.Row, 2), " ") 'si contenu<>"", on le place dans un tableau et on le decoupe
            For j = 0 To UBound(ArrWd) 'on analyse pour chaque decoupe s'il correspond a un chekbox
                If UserForm1.CheckBox0.Caption = ArrWd(j) Then UserForm1.CheckBox0 = True 'auquel cas on coche
                If UserForm1.CheckBox1.Caption = ArrWd(j) Then UserForm1.CheckBox1 = True
                If UserForm1.CheckBox2.Caption = ArrWd(j) Then UserForm1.CheckBox2 = True
            Next j
            Exit For 'sortie de routine, gain de temps
        End If
        Exit For
    End If
Next i
End Sub
Sub coche()
Dim r As Range
Dim i As Integer
'On  passe en revue tous les elements pour savoir lequel est selectionner
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
    'si selectionner, recherche l'element dans la feuille pour n'en retenir que l'ordonné(ligne)
    Set r = Feuil4.Columns(1).Find(ListBox1.List(i))
'        passe en revue les trois checkbox
        For j = 0 To 2
'            si croix dans checkbox
            If UserForm1.Controls("CheckBox" & j) = True Then
'            met la couleur en memoire
            temp = temp & " " & UserForm1.Controls("CheckBox" & j).Caption
            End If
        Next j
    'recupere la valeurs mis en memoire pour la coller sur la feuille
    Cells(r.Row, 2) = temp
    Exit For
    End If
Next i
End Sub

Voici le code commenter, apres test, j'ai changer quelques lignes par rapport au fichier que j'ai envoyé. (nul n'est parfait)

Merci, j'ai rentré ton code mais au moment de cliquer sur les elements dans ma listbox, j'ai une erreur 424 qui s'affiche avec objet requis.

Voici la ligne qui semble poser problème :

Code :

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

Set r = Ordre_du_jour.Columns(20).Find(ListBox1.List(i))

[keygen08]

Bonjour
c'est quoi "ordre_du_jour"
et plutôt que de mettre mon code, que tout le monde connait puisque dans le post precedent, colle plutôt Ton code avec les modifications apportées
Je pense que ordre_du jour est la feuille ou tu veux cherché alors il faut ecrire

Code :

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

Set r =  sheets("ordre_du_jour") .Columns(20).Find(ListBox1.List(i))

ou alors

Code :

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

Set r =  feuil1.Columns(20).Find(ListBox1.List(i))

qui correspond a l'appelation de la feuille ordre du jour dans la fenetre VBA (son codename)

[Baptiste3687]

Bonjour,

Merci c'est bon l'erreur est corrigée. Cependant une autre apparaît. Je met mon code qui est à moitié fini.

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
57
58
59
60
61
62
Private Sub UserForm_Initialize()
ListBox1.RowSource = "u17:u" & Cells(Cells.Rows.Count, 7).End(xlUp).Row
End Sub
 
Private Sub Verte_click()
Call coche
End Sub
Private Sub Bleu_click()
Call coche
End Sub
Private Sub Rouge_click()
Call coche
End Sub
 
Private Sub ListBox1_change()
Dim j As Integer, i As Integer
Dim ArrWd
'decoche les checkbox
 
        Verte = False
        Bleu = False
        Rouge = False
 
'On  passe en revue tous les elements pour savoir lequel est selectionner
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
    Set r = Sheets("ordre_du_jour").Columns(20).Find(ListBox1.List(i))
    'si selectionner, recherche l'element dans la feuille pour n'en retenir que le contenu
        If Not r.Offset(0, 1) = "" Then 'si pas de contenu, on sors, gain de temps
        ArrWd = Split(Cells(r.Row, 2), " ") 'si contenu<>"", on le place dans un tableau et on le decoupe
            For j = 0 To UBound(ArrWd) 'on analyse pour chaque decoupe s'il correspond a un chekbox
                If UserForm1.Verte.Caption = ArrWd(j) Then UserForm1.Verte = True 'auquel cas on coche
                If UserForm1.Bleu.Caption = ArrWd(j) Then UserForm1.Bleu = True
                If UserForm1.Rouge.Caption = ArrWd(j) Then UserForm1.Rouge= True
            Next j
            Exit For 'sortie de routine, gain de temps
        End If
        Exit For
    End If
Next i
End Sub
Sub coche()
Dim r As Range
Dim i As Integer
'On  passe en revue tous les elements pour savoir lequel est selectionner
For i = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(i) = True Then
    'Set r =  sheets("ordre_du_jour").Columns(20).Find(ListBox1.List(i))
'        passe en revue les trois checkbox
        For j = 0 To 2
'            si croix dans checkbox
            If UserForm1.Controls("CheckBox" & j) = True Then
'            met la couleur en memoire
            temp = temp & " " & UserForm1.Controls("CheckBox" & j).Caption
            End If
        Next j
    'recupere la valeurs mis en memoire pour la coller sur la feuille
    Cells(r.Row, 2) = temp
    Exit For
    End If
Next i
End Sub

Voici la ligne qui me met une erreur 91 : Variable objet ou variable de bloc with non définie

Code :

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

If Not r.Offset(0, 1) = "" Then 'si pas de contenu, on sors, gain de temps

Je rappel quand même que je ne veut pas colorier la case mais bien écrire le nom de la couleur. Juste pour éviter toute confusion.


Merci d'avance

[keygen08]

Bonsoir
Dans mon exemple, les fruits était en colonne A et les couleur en colonne B
Si pour une cellule donné, (r) se trouvant dans la colonne A, la colonne B ne contient pas de valeur, il est inutile que je decompose cette celule pour analyser blablabla, bref, je passe directement a ligne suivante
d'apres le message d'erreur, c'est cette ligne qui renvoi l'erreur, mais c'est la ligne au dessus qui est en cause

on definit la ligne (r) avec le set r, si celui ci ne renvoi rien, il y a erreur dans la ligne suivante qui est censé voir le r comme une cellule.
donc en modifiant comme ceci ça devrait aller.

Code :

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

        If not r is nothing  and  r.Offset(0, 1) <> "" Then 'si pas de valeur, on sors, gain de temps

j'ai bien compris que l'on parlais d'écrire les couleurs, pas de souci.

[Baptiste3687]

Bonsoir,

J'ai toujours la même erreur.

Cependant, je voudrai savoir où est le nom des cellules a remplir dans ton code. Car je ne trouve pas et c'est peut-être ca qui es la cause de mon erreur.

[keygen08]

Dans la sub coche, 5 eme ligne en partant de la fin

Code :

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

Cells(r.Row, 2) = temp

donc ligne(r), colonne B


et en modifiant comme ceci

Code :

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

1
2
If Not r Is Nothing Then
        If Not r.Offset(0, 1) = "" Then

il faut rajouter END IF en dessous du premier exit for

[Baptiste3687]

Encore une autre erreur...

Code :

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

If UserForm1.Controls("CheckBox" & j) = True Then

erreur -2147024809(80070057)
Objet spécifié introuvable.

[keygen08]

Comment s'appelle tes checkbox, les miens s'appelais checkbox0, checkbox1, checkbox2

[Baptiste3687]

Pour moi checkbox0= verte Checkbox1= bleu checkbox2= rouge.

Et j'ai réussit a "résoudre l'ancienne erreur en mettant

Code :

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

If Not (r Is Nothing) Then

[keygen08]

Dans ce cas quel est le nom du userform