VBA à but statistique

**nattalia** · 18/11/2013, 09h48

Bonjour
Je suis novice dans le VBA et j'ai crée un formulaire afin de rentrée mes saisies de statistique (d'hygiène des mains).
Dans mon formulaire, j'ai la partie supérieur (date, unité, n° de formulaire...) qui ne change que lorsque je fini de rentrée mes données, avant de passé au formulaire suivant. Et la partie "saisie par indication" qui change après chaque validation.

Je n'arrive pas à couper les deux et à faire en sorte que, par exemple, la date, le n° de formulaire, reste et re rentre sur ma feuille excel à chaque saisie et que mes donnée par indication change à chaque validation.

Je ne sais pas si je suis très claire dans mes explications???

Merci à vous !

Nat

**Daniel.C** · 18/11/2013, 10h47

Bonjour,

Le mieux serait que tu mettes ton classeur - sans données confidentielles - en pièce jointe.

**nattalia** · 18/11/2013, 11h25

Alors, voici la pièce jointe

Merci

**EngueEngue** · 18/11/2013, 11h28

Tu diras à celui qui t'a fait ce code... Qu'il ne sert à rien

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
Private Sub CommandButton5_Click()
Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 
 
 
 
    Unload UserForm1
    Load UserForm1
    UserForm1.Show
 
 
 
End Sub
 
 
 
Private Sub CommandButton6_Click()
Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 
 
    Unload UserForm1
    Load UserForm1
    UserForm1.Show
 
 
 
End Sub

**nattalia** · 18/11/2013, 11h42

Oui, je sais, je me débrouille avec les tutos en lignes, mais c'est pas simple...! Mes deux boutons ont le même code et je devrais pouvoir avoir celui "valider" que pour la partie "saisie par indication" en gardant les info de saisie groupée, mais je n'y arrive pas !

Help !!!

**Daniel.C** · 18/11/2013, 12h38

Remplace tout le code du userform par :

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
63
64
65
66
67
68
69
70
Private Sub CommandButton1_Click()
Sheets("infirmière").Select
End Sub
 
Private Sub CommandButton2_Click()
Sheets("autres").Select
End Sub
 
Private Sub CommandButton3_Click()
Sheets("medecin").Select
End Sub
 
Private Sub CommandButton4_Click()
Sheets("aide").Select
End Sub
 
Private Sub CommandButton5_Click()
Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 
 
 
 
    Unload UserForm1
    Load UserForm1
    UserForm1.Show
 
 
 
End Sub
 
 
 
Private Sub CommandButton6_Click()
Rows("2:2").Insert
[A2] = TextBox1
[B2] = TextBox2
[C2] = TextBox3
[E2:M2].Value = 0
If CheckBox1.Value Then
    Range("J2").Value = 1
End If
If CheckBox2.Value Then
    Range("L2").Value = 1
End If
If CheckBox3.Value Then
    Range("M2").Value = 1
End If
If CheckBox4.Value Then
    Range("E2").Value = 1
End If
If CheckBox5.Value Then
    Range("F2").Value = 1
End If
If CheckBox6.Value Then
    Range("G2").Value = 1
End If
If CheckBox7.Value Then
    Range("H2").Value = 1
End If
If CheckBox8.Value Then
    Range("I2").Value = 1
End If
If CheckBox9.Value Then
    Range("K2").Value = 1
End If
For i = 1 To 9
    Me.Controls("CheckBox" & i).Value = False
Next i
End Sub

et teste.

**Daniel.C** · 18/11/2013, 14h56

Bonjour EngueEngue :

Pas d'accord; c'est une méthode maladroite mais efficace pour réinitialiser tous les contrôles.

**nattalia** · 18/11/2013, 15h01

C'est trop génial, merci 1000 x. Maintenant, il faut que je le refasse !!!!

Est-ce que je peux encore abuser et poser deux autres questions ?

- Si je veux mettre ma nouvelle ligne en dessous et pas au-dessus, je remplace juste down par up dans le bouton5 ?

- Comment je dois faire si dans mes choix (exemple : c'est soit FHA soit lavage, mais on ne peut pas mettre les deux, et si il y a 0 action, il ne peut pas y avoir FHA ou lavage...?

Merci encore !

**Daniel.C** · 18/11/2013, 16h02

J'ai ajouté cette ligne dans "Module1" :

Code :

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

Public Ligne As Long, Teste As Boolean

Le code est modifié comme suit :

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Private Sub CommandButton1_Click()
Sheets("infirmière").Select
End Sub
 
Private Sub CommandButton2_Click()
Sheets("autres").Select
End Sub
 
Private Sub CommandButton3_Click()
Sheets("medecin").Select
End Sub
 
Private Sub CommandButton4_Click()
Sheets("aide").Select
End Sub
 
Private Sub CommandButton5_Click()
    Ligne = Ligne + 1
    Teste = True
    Unload UserForm1
    Load UserForm1
    UserForm1.Show
End Sub
 
 
 
Private Sub CommandButton6_Click()
Ligne = Ligne + 1
Cells(Ligne, 1) = TextBox1
Cells(Ligne, 2) = TextBox2
Cells(Ligne, 3) = TextBox3
Cells(Ligne, 5).Resize(, 9).Value = 0
If CheckBox9.Value And (Me.CheckBox1.Value Or Me.CheckBox2.Value) Then
    MsgBox "Erreur de saisie"
    Exit Sub
End If
If Me.CheckBox1.Value And Me.CheckBox2.Value Then
    MsgBox "Erreur de saisie"
    Exit Sub
End If
If CheckBox1.Value Then
    Cells(Ligne, "J").Value = 1
End If
If CheckBox2.Value Then
    Cells(Ligne, "L").Value = 1
End If
If CheckBox3.Value Then
    Cells(Ligne, "M").Value = 1
End If
If CheckBox4.Value Then
    Cells(Ligne, "E").Value = 1
End If
If CheckBox5.Value Then
    Cells(Ligne, "F").Value = 1
End If
If CheckBox6.Value Then
    Cells(Ligne, "G").Value = 1
End If
If CheckBox7.Value Then
    Cells(Ligne, "H").Value = 1
End If
If CheckBox8.Value Then
    Cells(Ligne, "I").Value = 1
End If
If CheckBox9.Value Then
    Cells(Ligne, "K").Value = 1
End If
For i = 1 To 9
    Me.Controls("CheckBox" & i).Value = False
Next i
End Sub
 
Private Sub UserForm_Initialize()
    With Sheets("Autres")
        If Teste = True Then
            Teste = False
        Else
            Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
        End If
    End With
End Sub

Les messages d'incompatibilité de saisie n'apparaissent que lorsqu'on appuie sur le bouton "Validation". Cette partie est gérée par cette partie :

Code :

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

1
2
3
4
5
6
7
8
If CheckBox9.Value And (Me.CheckBox1.Value Or Me.CheckBox2.Value) Then
    MsgBox "Erreur de saisie"
    Exit Sub
End If
If Me.CheckBox1.Value And Me.CheckBox2.Value Then
    MsgBox "Erreur de saisie"
    Exit Sub
End If

Regarde le classeur joint.

**nattalia** · 19/11/2013, 10h42

Bonjour (et merci Daniel pour ton aide)

Mais je n'ai hélas pas compris ton dernier message, trop d'info en un coup je crois.

J'ai donc sauvegarder mon projet comme il fonctionne le mieux et je dois doit encore faire des petites retourches :

- J'ai un ligne qui se met à la fin de ma validation quand je change de formulaire avec des 0 partout !?!
- Je n'ai pas compris la ligne à rajouter dans le module1, ça ne marche pas !
et je ne sais pas à quoi elle va servir ???
- Quand j'ai testé un des codes (je ne sais pas lequel, tout c'est marqué sur la ligne 1, donc, sur les titres, j'ai donc peu de mettre en pratique les cases à cocher...!

Encore merci pour votre aide précieuse !

Nat

**Daniel.C** · 19/11/2013, 13h20

Est-ce que tu as testé avec le classeur que j'ai mis en PJ, ou avec celui que tu viens de poster ?

**nattalia** · 19/11/2013, 14h19

J'ai testé celui que tu m'as mis en pièce jointe, mais il a une erreur de compilation que je ne déchiffre pas.
Du coup, j'ai prit quelques lignes ici et là, mais pas tout le fichier.
La chose la plus importante que je cherche à faire maintenant, c'est que la ligne d'écriture se créer en dessous de l'autre et pas au dessus et que la dernière ne soit pas à o.
Merci

Alors voilà, ça va mieux, j'ai pu mettre les codes de ton exemple en place, mais j'ai des info qui ne se note pas (durée d'observation et unité) et quand je fait nouveau formulaire, il se remet sur la ligne 2.
Voilà la pièce jointe.

**Daniel.C** · 19/11/2013, 15h43

Tu aurais dû me préciser que le formulaire pouvait alimenter plusieurs feuilles...

Regarde le classeur joint.

**nattalia** · 20/11/2013, 09h55

Bonjour Daniel

J'ai testé le fichier et je me demande si c'est possible qu'il n'y ai pas de lignes vides sur les tableaux de mes 4 feuilles ? Par la suite, je devrai filtrer le contenu de ces tableaux pour faire mes stats et ça ne marchera pas !

J'ai aussi oublié une colonne (geste additionnel), comme fait on pour l'intégré au bouton "valider l'opportunité "?

Encore merci

Voir nouvelle pièce jointe

**Daniel.C** · 20/11/2013, 10h50

Bonjour,

Remplace ces deux macros par le code ci-dessous :

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
Private Sub CommandButton5_Click()
    For i = 1 To 9
        Me.Controls("CheckBox" & i).Value = False
    Next i
    Me.ComboBox1.ListIndex = -1
    Me.ComboBox2.ListIndex = -1
    Me.TextBox1.Text = ""
    Me.TextBox2.Text = ""
End Sub
 
 
 
Private Sub CommandButton6_Click()
Ligne = Ligne + 1
Cells(Ligne, 1) = TextBox1
Cells(Ligne, 2) = TextBox2
Cells(Ligne, 3) = TextBox3
Cells(Ligne, 3) = Me.ComboBox2.Value
Cells(Ligne, 4) = Me.ComboBox1.Value
Cells(Ligne, 14) = Me.TextBox3.Value
Cells(Ligne, 5).Resize(, 9).Value = 0
If CheckBox9.Value And (Me.CheckBox1.Value Or Me.CheckBox2.Value) Then
    MsgBox "Erreur de saisie"
    Exit Sub
End If
If Me.CheckBox1.Value And Me.CheckBox2.Value Then
    MsgBox "Erreur de saisie"
    Exit Sub
End If
If CheckBox1.Value Then
    Cells(Ligne, "J").Value = 1
End If
If CheckBox2.Value Then
    Cells(Ligne, "L").Value = 1
End If
If CheckBox3.Value Then
    Cells(Ligne, "M").Value = 1
End If
If CheckBox4.Value Then
    Cells(Ligne, "E").Value = 1
End If
If CheckBox5.Value Then
    Cells(Ligne, "F").Value = 1
End If
If CheckBox6.Value Then
    Cells(Ligne, "G").Value = 1
End If
If CheckBox7.Value Then
    Cells(Ligne, "H").Value = 1
End If
If CheckBox8.Value Then
    Cells(Ligne, "I").Value = 1
End If
If CheckBox9.Value Then
    Cells(Ligne, "K").Value = 1
End If
For i = 1 To 9
    Me.Controls("CheckBox" & i).Value = False
Next i
End Sub

**nattalia** · 20/11/2013, 11h13

J'ai fait le changement, cela intègre la colonne geste additionnel,

mais

-j'ai toujours des lignes vides quand je change de feuille (je ne sais pas si c'est possible de faire autrement ?)

- Lorsque je valide l'opportunité, la case geste additionnel ne se vide pas (comme les autres cases à cocher).

Merci

Nat

**Daniel.C** · 20/11/2013, 11h42

Je ne constate pas ce problème de lignes vides. Donne-moi un exemple. Note que je travaille à partir du classeur V6 modifié.Remplace cette macro pour l'effacement du textbox :

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
Private Sub CommandButton6_Click()
Ligne = Ligne + 1
Cells(Ligne, 1) = TextBox1
Cells(Ligne, 2) = TextBox2
Cells(Ligne, 3) = TextBox3
Cells(Ligne, 3) = Me.ComboBox2.Value
Cells(Ligne, 4) = Me.ComboBox1.Value
Cells(Ligne, 14) = Me.TextBox3.Value
Cells(Ligne, 5).Resize(, 9).Value = 0
If CheckBox9.Value And (Me.CheckBox1.Value Or Me.CheckBox2.Value) Then
    MsgBox "Erreur de saisie"
    Exit Sub
End If
If Me.CheckBox1.Value And Me.CheckBox2.Value Then
    MsgBox "Erreur de saisie"
    Exit Sub
End If
If CheckBox1.Value Then
    Cells(Ligne, "J").Value = 1
End If
If CheckBox2.Value Then
    Cells(Ligne, "L").Value = 1
End If
If CheckBox3.Value Then
    Cells(Ligne, "M").Value = 1
End If
If CheckBox4.Value Then
    Cells(Ligne, "E").Value = 1
End If
If CheckBox5.Value Then
    Cells(Ligne, "F").Value = 1
End If
If CheckBox6.Value Then
    Cells(Ligne, "G").Value = 1
End If
If CheckBox7.Value Then
    Cells(Ligne, "H").Value = 1
End If
If CheckBox8.Value Then
    Cells(Ligne, "I").Value = 1
End If
If CheckBox9.Value Then
    Cells(Ligne, "K").Value = 1
End If
For i = 1 To 9
    Me.Controls("CheckBox" & i).Value = False
Next i
Me.TextBox3.Text = ""
End Sub

**nattalia** · 20/11/2013, 12h01

Je t’envoie la dernière version, avec toutes les corrections. Lorsque que je rentre par exemple deux lignes "d'opportunité" sur la feuille infirmière, puis que je passe, avec le même formulaire (même date...) sur la feuille "aide" et que je continue de rentrée mes données, elles se mettent sur la ligne 4, car la 2 et la 3 sont déjà remplie chez l'infirmière.

Après ça, je te jure, je te laisse tranquille !!! Je suis désolée, mais j'apprends beaucoup, c'est cool !

Merci

http://www.developpez.net/forums/ima...lies/merci.png

**Daniel.C** · 20/11/2013, 12h23

Oups. Au temps pour moi ! je n'avais pas vu qu'on pouvait passer d'une feuille à l'autre avec les boutons du haut. Remplace leurs macros :

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 CommandButton1_Click()
Sheets("infirmière").Select
With ActiveSheet
    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
End Sub
 
Private Sub CommandButton2_Click()
Sheets("autres").Select
With ActiveSheet
    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
End Sub
 
Private Sub CommandButton3_Click()
Sheets("medecin").Select
With ActiveSheet
    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
End Sub
 
Private Sub CommandButton4_Click()
Sheets("aide").Select
With ActiveSheet
    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
End Sub

**nattalia** · 21/11/2013, 09h27

C'est super ! Tout fonctionne comme sur des roulettes. Merci 1000 fois.

Je clos donc la discussion, mais j'ai l'intention de mettre des petits suppléments, comme des retour de résultat dans le formulaire, et surtout, un bouton d'annulation de saisie en cas de correction ou de remise à zéro de tout le formulaire.

Je vais me creuser un peu la tête pour trouver quelques solutions, puis, je pense que je reviendrai vers le site pour les bugs !!!

Encore merci

Nat

VBA à but statistique [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager