Ajout données via formulaire

Version imprimable

19/02/2012, 20h32
OliFossa

Ajout données via formulaire

Bonsoir à tous,

Voilà quelques heures que je cherche comment effectuer une commande sûrement simple, mais qui me pose des difficultés en terme de codage. Je me permets donc de vous l'exprimer via un nouveau topic.

Voici mon problème:

J'ai une macro qui ouvre tout d'abord une inputbox pour définir le nombre de personnes pour lesquelles je veux entrer des données. En fonction du nombre que j'indique, elle m'ouvre X mêmes formulaires dans lesquels j'entre les données, traduites dans mon tableau Excel.

Cependant, j'aimerais pouvoir ré-ouvrir ce formulaire avec une macro qui me demanderait pour combien de personnes je veux refaire le test. Ceci tout en gardant les lignes déjà occupées par les données.

J'imagine que je ne dois pas changer toute ma macro, mais juste ajouter ou modifier l'une ou l'autre ligne ?

Merci à ceux qui se pencheront sur ce petit souci =)
19/02/2012, 20h50
jfontaine

Bonjour,

Et la macro !!! :?

Sans elle difficile de te dire

Pardon, petite distraction de ma part. Voici le code :

Merci

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
Sub EmployeesDatas()
'
' EmployeesDatas Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+D
'
MsgBox ("This system will ask you to enter the datas of each candidate")
Cells(2, 1) = "PUID"
Cells(2, 2) = "Full Name"
Cells(2, 3) = "Job Title"
Cells(2, 4) = "Responsibility"
Cells(2, 5) = "Country Code"
Cells(2, 6) = "Division"
Cells(2, 7) = "GEC Leader"
Cells(2, 8) = "Recruitment Year"
 
Cells(2, 9) = "In"
Cells(2, 10) = "Year"
 
Cells(2, 11) = "Most Recent CV"
Cells(2, 12) = "TSF 2010"
Cells(2, 13) = "TSF 2011"
Cells(2, 14) = "Current JD"
 
Cells(2, 15) = "2010"
Cells(2, 16) = "2011"
 
Cells(2, 17) = "English"
Cells(2, 18) = "Spanish"
Cells(2, 19) = "German"
Cells(2, 20) = "Dutch"
Cells(2, 21) = "Italian"
Cells(2, 22) = "Swedish"
Cells(2, 23) = "Norwegian"
Cells(2, 24) = "Danish"
Cells(2, 25) = "French"
Cells(2, 26) = "Mandarin"
Cells(2, 27) = "Other"
 
Cells(2, 28) = "Nationally"
Cells(2, 29) = "Western Europe"
Cells(2, 30) = "Scandinavia"
Cells(2, 31) = "CEE"
Cells(2, 32) = "North America"
Cells(2, 33) = "South America"
Cells(2, 34) = "CN/TH/SG"
Cells(2, 35) = "India"
Cells(2, 36) = "Japan"
Cells(2, 37) = "Other"
 
n = InputBox("How many employees?")
For i = 3 To n + 2
 
DataSheetForm.Show
 
' Personnal Datas
    Cells(i, 1) = DataSheetForm.PUID.Text
    Cells(i, 2) = DataSheetForm.FullName.Text
    Cells(i, 3) = DataSheetForm.JobTitle.Text
    Cells(i, 4) = DataSheetForm.Responsibility.Text
    Cells(i, 5) = DataSheetForm.CountryCode.Text
    Cells(i, 6) = DataSheetForm.DivisionBox.Text
    Cells(i, 7) = DataSheetForm.GECLeaderBox.Text
    Cells(i, 8) = DataSheetForm.RecruitmentYearBox.Text
    Cells(i, 9) = DataSheetForm.PromotionBox.Text
    Cells(i, 10) = Cells(i, 8) + Cells(i, 9)
    Promotionyear = Cells(i, 10)
 
' Documents
    Cells(i, 11) = CheckBoxCaption(DataSheetForm.CheckBox20.Value)
    Cells(i, 12) = CheckBoxCaption(DataSheetForm.CheckBox21.Value)
    Cells(i, 13) = CheckBoxCaption(DataSheetForm.CheckBox22.Value)
    Cells(i, 14) = CheckBoxCaption(DataSheetForm.CheckBox23.Value)
 
' TSF Score
    Cells(i, 15) = DataSheetForm.Score2010Box.Text
    Cells(i, 16) = DataSheetForm.Score2011Box.Text
 
' Languages
    Cells(i, 17) = CheckBoxCaption(DataSheetForm.CheckBox1.Value)
    Cells(i, 18) = CheckBoxCaption(DataSheetForm.CheckBox2.Value)
    Cells(i, 19) = CheckBoxCaption(DataSheetForm.CheckBox3.Value)
    Cells(i, 20) = CheckBoxCaption(DataSheetForm.CheckBox4.Value)
    Cells(i, 21) = CheckBoxCaption(DataSheetForm.CheckBox5.Value)
    Cells(i, 22) = CheckBoxCaption(DataSheetForm.CheckBox6.Value)
    Cells(i, 23) = CheckBoxCaption(DataSheetForm.CheckBox7.Value)
    Cells(i, 24) = CheckBoxCaption(DataSheetForm.CheckBox8.Value)
    Cells(i, 25) = CheckBoxCaption(DataSheetForm.CheckBox9.Value)
    Cells(i, 26) = CheckBoxCaption(DataSheetForm.CheckBox10.Value)
    Cells(i, 27) = DataSheetForm.TextBox1.Text
 
' Mobility
    Cells(i, 28) = CheckBoxCaption(DataSheetForm.CheckBox11.Value)
    Cells(i, 29) = CheckBoxCaption(DataSheetForm.CheckBox12.Value)
    Cells(i, 30) = CheckBoxCaption(DataSheetForm.CheckBox13.Value)
    Cells(i, 31) = CheckBoxCaption(DataSheetForm.CheckBox14.Value)
    Cells(i, 32) = CheckBoxCaption(DataSheetForm.CheckBox15.Value)
    Cells(i, 33) = CheckBoxCaption(DataSheetForm.CheckBox16.Value)
    Cells(i, 34) = CheckBoxCaption(DataSheetForm.CheckBox17.Value)
    Cells(i, 35) = CheckBoxCaption(DataSheetForm.CheckBox18.Value)
    Cells(i, 36) = CheckBoxCaption(DataSheetForm.CheckBox19.Value)
    Cells(i, 37) = DataSheetForm.TextBox2.Text
 
Unload DataSheetForm
 
Next i
 
 
 
    Dim shSource As Worksheet
    Dim shCible As Worksheet
 
    Dim rngRowSource As Range
    Dim rngRowCible As Range
 
    Set shSource = Sheets("TG")
    Set asCible = Sheets("HP")
 
    Set rngRowSource = shSource.Range("A3:AK3")
    Set rngRowCible = asCible.Range("A3:AK3")
 
 
    While Not (rngRowSource.Cells(1, 1) = "")
 
        Debug.Print rngRowSource.Cells(1, 1)
 
        If (rngRowSource.Cells(1, 10)) = "2012" Then
            Debug.Print rngRowSource.Cells(1, 10)
 
            rngRowSource.Copy
            rngRowCible.PasteSpecial xlPasteValues
 
            Set rngRowCible = rngRowCible.Offset(1)
        End If
 
        Set rngRowSource = rngRowSource.Offset(1)
 
    Wend
 
End Sub
 
Private Function CheckBoxCaption(theCheckBoxValue As Boolean) As String
    Select Case theCheckBoxValue
        Case True
            CheckBoxCaption = "Yes"
        Case False
            CheckBoxCaption = "No"
    End Select
End Function

En se positionnant sur la prochaine ligne vide, cela devrait faire ce que tu souhaites
Code:

1 2 Dim Deligne as long Derligne = Range("A" & Rows.Count).End(Xlup).Row
Puis
Code:

1 2 3 4 5 6 For i = 3 To n + 2 DataSheetForm.Show ' Personnal Datas Cells(i + Derligne, 1) = DataSheetForm.PUID.Text

19/02/2012, 22h30
mercatog

A mon sens, l'approche n'est pas la bonne.
L'inputbox demande le nombre d'employés à entrer, ensuite la boucle qui charge ton userform et transfert les données (lesquels??) vers la feuille.
L'utilisateur n'est pas appelé à saisir sur ton usf quoi que ce soit.

Il faudra, ajouter 2 boutons sur ton usf, l'un pour ajouter et l'autre pour fermer.
L'utilisateur ajoutera les employés jusqu'à ce qu'il termine et ferme son usf
20/02/2012, 09h29
OliFossa

Bonjour,

Merci pour vos réponses.

Lorsque j'insère le code avec la mention Derligne, le débogueur surligne en jaune " Derligne = Range... .Row", avec erreur d'exécution '1004'.

Que faire ?

@ Mercatog : L'utilisateur est amené a entrer les données dans le nombre d'usf défini par l'inputbox. Ajouter 2 boutons ne résoudrait pas le problème d'ajouter de nouveaux employés par après, une fois le programme fermé et puis ré-ouvert. Ou alors j'ai mal compris.
20/02/2012, 09h36
casefayere
Bonjour,

Citation:

Lorsque j'insère le code avec la mention Derligne, le débogueur surligne en jaune " Derligne = Range... .Row", avec erreur d'exécution '1004'.

es-tu sur la bonne feuille quand tu exécutes le code ?
Spécifies le nom de ta feuille :
Code:

1 2 3 4 5 ... With Sheets("nomdetafeuille") Derligne = .Range("A" & .Rows.Count).End(Xlup).Row End With ....

Je viens d'effectuer la modification, mais hélas rien n'y fait :...

Voici le code, peut-être ai-je mal positionné certaines commandes ?

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
Sub EmployeesDatas()
'
' EmployeesDatas Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+D
'
MsgBox ("This system will ask you to enter the datas of each candidate")
Cells(2, 1) = "PUID"
Cells(2, 2) = "Full Name"
Cells(2, 3) = "Job Title"
Cells(2, 4) = "Responsibility"
Cells(2, 5) = "Country Code"
Cells(2, 6) = "Division"
Cells(2, 7) = "GEC Leader"
Cells(2, 8) = "Recruitment Year"
 
Cells(2, 9) = "In"
Cells(2, 10) = "Year"
 
Cells(2, 11) = "Most Recent CV"
Cells(2, 12) = "TSF 2010"
Cells(2, 13) = "TSF 2011"
Cells(2, 14) = "Current JD"
 
Cells(2, 15) = "2010"
Cells(2, 16) = "2011"
 
Cells(2, 17) = "English"
Cells(2, 18) = "Spanish"
Cells(2, 19) = "German"
Cells(2, 20) = "Dutch"
Cells(2, 21) = "Italian"
Cells(2, 22) = "Swedish"
Cells(2, 23) = "Norwegian"
Cells(2, 24) = "Danish"
Cells(2, 25) = "French"
Cells(2, 26) = "Mandarin"
Cells(2, 27) = "Other"
 
Cells(2, 28) = "Nationally"
Cells(2, 29) = "Western Europe"
Cells(2, 30) = "Scandinavia"
Cells(2, 31) = "CEE"
Cells(2, 32) = "North America"
Cells(2, 33) = "South America"
Cells(2, 34) = "CN/TH/SG"
Cells(2, 35) = "India"
Cells(2, 36) = "Japan"
Cells(2, 37) = "Other"
 
Dim Derligne As Long
With Sheets("TG")
    Derligne = .Range("A" & Rows.Count).End(X1up).Row
 
End With
 
n = InputBox("How many employees?")
For i = 3 To n + 2
 
DataSheetForm.Show
 
' Personnal Datas
    Cells(i + Derligne, 1) = DataSheetForm.PUID.Text
    Cells(i + Derligne, 2) = DataSheetForm.FullName.Text
    Cells(i + Derligne, 3) = DataSheetForm.JobTitle.Text
    Cells(i + Derligne, 4) = DataSheetForm.Responsibility.Text
    Cells(i + Derligne, 5) = DataSheetForm.CountryCode.Text
    Cells(i + Derligne, 6) = DataSheetForm.DivisionBox.Text
    Cells(i + Derligne, 7) = DataSheetForm.GECLeaderBox.Text
    Cells(i + Derligne, 8) = DataSheetForm.RecruitmentYearBox.Text
    Cells(i + Derligne, 9) = DataSheetForm.PromotionBox.Text
    Cells(i + Derligne, 10) = Cells(i, 8) + Cells(i, 9)
    Promotionyear = Cells(i, 10)
 
' Documents
    Cells(i + Derligne, 11) = CheckBoxCaption(DataSheetForm.CheckBox20.Value)
    Cells(i + Derligne, 12) = CheckBoxCaption(DataSheetForm.CheckBox21.Value)
    Cells(i + Derligne, 13) = CheckBoxCaption(DataSheetForm.CheckBox22.Value)
    Cells(i + Derligne, 14) = CheckBoxCaption(DataSheetForm.CheckBox23.Value)
 
' TSF Score
    Cells(i + Derligne, 15) = DataSheetForm.Score2010Box.Text
    Cells(i + Derligne, 16) = DataSheetForm.Score2011Box.Text
 
' Languages
    Cells(i + Derligne, 17) = CheckBoxCaption(DataSheetForm.CheckBox1.Value)
    Cells(i + Derligne, 18) = CheckBoxCaption(DataSheetForm.CheckBox2.Value)
    Cells(i + Derligne, 19) = CheckBoxCaption(DataSheetForm.CheckBox3.Value)
    Cells(i + Derligne, 20) = CheckBoxCaption(DataSheetForm.CheckBox4.Value)
    Cells(i + Derligne, 21) = CheckBoxCaption(DataSheetForm.CheckBox5.Value)
    Cells(i + Derligne, 22) = CheckBoxCaption(DataSheetForm.CheckBox6.Value)
    Cells(i + Derligne, 23) = CheckBoxCaption(DataSheetForm.CheckBox7.Value)
    Cells(i + Derligne, 24) = CheckBoxCaption(DataSheetForm.CheckBox8.Value)
    Cells(i + Derligne, 25) = CheckBoxCaption(DataSheetForm.CheckBox9.Value)
    Cells(i + Derligne, 26) = CheckBoxCaption(DataSheetForm.CheckBox10.Value)
    Cells(i + Derligne, 27) = DataSheetForm.TextBox1.Text
 
' Mobility
    Cells(i + Derligne, 28) = CheckBoxCaption(DataSheetForm.CheckBox11.Value)
    Cells(i + Derligne, 29) = CheckBoxCaption(DataSheetForm.CheckBox12.Value)
    Cells(i + Derligne, 30) = CheckBoxCaption(DataSheetForm.CheckBox13.Value)
    Cells(i + Derligne, 31) = CheckBoxCaption(DataSheetForm.CheckBox14.Value)
    Cells(i + Derligne, 32) = CheckBoxCaption(DataSheetForm.CheckBox15.Value)
    Cells(i + Derligne, 33) = CheckBoxCaption(DataSheetForm.CheckBox16.Value)
    Cells(i + Derligne, 34) = CheckBoxCaption(DataSheetForm.CheckBox17.Value)
    Cells(i + Derligne, 35) = CheckBoxCaption(DataSheetForm.CheckBox18.Value)
    Cells(i + Derligne, 36) = CheckBoxCaption(DataSheetForm.CheckBox19.Value)
    Cells(i + Derligne, 37) = DataSheetForm.TextBox2.Text
 
Unload DataSheetForm
 
Next i
 
 
 
    Dim shSource As Worksheet
    Dim shCible As Worksheet
 
    Dim rngRowSource As Range
    Dim rngRowCible As Range
 
    Set shSource = Sheets("TG")
    Set asCible = Sheets("HP")
 
    Set rngRowSource = shSource.Range("A3:AK3")
    Set rngRowCible = asCible.Range("A3:AK3")
 
 
    While Not (rngRowSource.Cells(1, 1) = "")
 
        Debug.Print rngRowSource.Cells(1, 1)
 
        If (rngRowSource.Cells(1, 10)) = "2012" Then
            Debug.Print rngRowSource.Cells(1, 10)
 
            rngRowSource.Copy
            rngRowCible.PasteSpecial xlPasteValues
 
            Set rngRowCible = rngRowCible.Offset(1)
        End If
 
        Set rngRowSource = rngRowSource.Offset(1)
 
    Wend
 
End Sub
 
Private Function CheckBoxCaption(theCheckBoxValue As Boolean) As String
    Select Case theCheckBoxValue
        Case True
            CheckBoxCaption = "Yes"
        Case False
            CheckBoxCaption = "No"
    End Select
End Function
 
 
'For i = 2 To shSource.Range("I" & Rows.Count).End(x1up).Row
'
'    If (shSource.Cells(i, 10)) = "2012" Then
'
'        rngOriginRow = shSource.Rows(i).Copy
'        'rngRow.Copy
'        shCible.Rows(i).Paste
'        '   shSource.Rows(i).Characters.Font.Italic = True
'        '   shSource.Rows(i).Characters.Font.Italic = True
'
'    End If
'Next i

20/02/2012, 11h46
mercatog

Citation:

@ Mercatog : L'utilisateur est amené a entrer les données dans le nombre d'usf défini par l'inputbox. Ajouter 2 boutons ne résoudrait pas le problème d'ajouter de nouveaux employés par après, une fois le programme fermé et puis ré-ouvert. Ou alors j'ai mal compris.

Effectivement, tu as mal compris ou bien je me suis mal exprimé.

Suis à la main ton code proposé:

1. Msgbox qui indique que le système va demander d'entrer les données
2. sur la ligne 2 de la feuille active, s'inscriront les titres
3. Une Input demandera à l'utilisateur d'entrer le nombre d'employés
4. L'userfrom DatSheetForm va être ouvert
5. Remarque que rien n'est encore inscrit sur les controls de l'userform
6. ce "rien" va être transféré vers la feuille active
7. l'userform se ferme
8. et à nouveau dans la boucle.

L'utilisateur n'aura la main pour saisir quoi ce soit.
20/02/2012, 12h01
OliFossa

Bien entendu, j'ai établi les procédures qui permettent à l'utilisateur de remplir le formulaire, mais je n'ai pas jugé utile de mettre les détails ici car tout cela fonctionne, les données que l'utilisateur insère sont bien transférées dans les feuilles.

Le problème réside juste dans le fait de devoir ajouter de nouvelles données à la suites de celles déjà écrites auparavant.

Bon c'est toi qui le dis.
Refais ton code comme ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
With Sheets("TG")
    n = InputBox("How many employees?")
    For i = 3 To n + 2
        DataSheetForm.Show
        Derligne = .Range("A" & Rows.Count).End(X1up).Row
        ' Personnal Datas
        .Cells(i + Derligne, 1) = DataSheetForm.PUID.Text
        .Cells(i + Derligne, 2) = DataSheetForm.FullName.Text
        .Cells(i + Derligne, 3) = DataSheetForm.JobTitle.Text
        .Cells(i + Derligne, 4) = DataSheetForm.Responsibility.Text
        .Cells(i + Derligne, 5) = DataSheetForm.CountryCode.Text
        '....
        Unload DataSheetForm
    Next i
End With

20/02/2012, 12h49
OliFossa

Je viens d'essayer, en rectifiant l'ordre des commandes, mais le même message d'erreur persiste toujours...

C'est à en perdre la tête

Toutefois, ne serait-il pas possible de remodeler les codes et de créer un bouton dans la feuille Excel "Ajouter nouvelle ligne", qui lancerait le formulaire?

Je n'ai pas regardé plus avant ton code mais il manque encore un point "." devant row
Code:

1 2 3 4 5 With Sheets("TG") n = InputBox("How many employees?") For i = 3 To n + 2 DataSheetForm.Show Derligne = .Range("A" & .Rows.Count).End(X1up).Row

20/02/2012, 16h04
mercatog

Code:

Derligne = .Range("A" & .Rows.Count).End(xlUp).Row

XLUP et non X1UP (c'était un L et non 1 (chiffre 1)