Ajout données via formulaire

**OliFossa** · 19/02/2012, 20h32

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

**jfontaine** · 19/02/2012, 20h50

Bonjour,

Et la macro !!!

Sans elle difficile de te dire

**OliFossa** · 19/02/2012, 22h06

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

Merci

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

**jfontaine** · 19/02/2012, 22h21

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

Code :

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

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

Puis

Code :

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

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

**mercatog** · 19/02/2012, 22h30

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

**OliFossa** · 20/02/2012, 09h29

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.

**casefayere** · 20/02/2012, 09h36

Bonjour,

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 :

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

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

**OliFossa** · 20/02/2012, 11h20

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 :

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

**mercatog** · 20/02/2012, 11h46

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

**OliFossa** · 20/02/2012, 12h01

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.

**mercatog** · 20/02/2012, 12h30

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

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

**OliFossa** · 20/02/2012, 12h49

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?

**casefayere** · 20/02/2012, 15h17

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

Code :

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

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

**mercatog** · 20/02/2012, 16h04

Code :

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

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

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

Ajout données via formulaire

Macros et VBA Excel

Discussions similaires

Partager

Partager