Code pour userform

Version imprimable

Voir 40 message(s) de cette discussion en une page

Code pour userform

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:

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.

26/09/2014, 16h55
keygen08

1 pièce(s) jointe(s)

Bonjour

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

Bonjour Baptiste

Citation:

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

Citation:

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:

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 ....)

Citation:

Envoyé par Baptiste3687

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:

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

Citation:

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:

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

05/10/2014, 00h16
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.

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:

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é.

05/10/2014, 13h47
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
06/10/2014, 21h57
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.

1 pièce(s) jointe(s)

Bonsoir,

Voici mon code :
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 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.

Pièce jointe 158107

Bonjour,

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

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
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é.

Bonjour

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
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)

Citation:

Envoyé par keygen08

Bonjour

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

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

08/10/2014, 10h59
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:

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

ou alors

Code:

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)

Bonjour,

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

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

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

08/10/2014, 22h08
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:

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.
08/10/2014, 22h29
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.
08/10/2014, 23h11
keygen08
Dans la sub coche, 5 eme ligne en partant de la fin

Code:

Cells(r.Row, 2) = temp

donc ligne(r), colonne B

et en modifiant comme ceci
Code:

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
08/10/2014, 23h17
Baptiste3687

Encore une autre erreur...

Code:

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

erreur -2147024809(80070057)
Objet spécifié introuvable.
08/10/2014, 23h19
keygen08

Comment s'appelle tes checkbox, les miens s'appelais checkbox0, checkbox1, checkbox2
08/10/2014, 23h22
Baptiste3687

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

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

Code:

If Not (r Is Nothing) Then
08/10/2014, 23h26
keygen08

Dans ce cas quel est le nom du userform

Voir 40 message(s) de cette discussion en une page