[XL-2007] Formulaire pour compléter/saisir des données [Résolu]

[apt]

Bonjour à tous,

J'ai un tableau de 6 colonnes (A à F).

J'aimerais ajouter un formulaire pour compléter des lignes insuffisamment renseignées ou saisir des nouvelles données et cela selon la valeur en colonne A qui contient des numéros.

1er cas, compléter :

Si le numéro saisi (tbN) existe déjà dans la colonne A, tout les valeurs existantes dans la ligne de ce numéro s'afficheront dans les contrôles respectifs du formulaire, et dans ce cas on devra compléter ce qui est vide.

2eme cas, saisir :

Si le numéro saisi (tbN) n'existe pas, tous les champs seront bien sur vide, et dans ce cas en a qu'à saisir les 6 valeurs manquantes.

Mais je n’y arrive pas encore.

Merci d’avance de votre aide.

[mercatog]

Une question
Comment tu lance ton usf? et comment savoir si c'est pour un ajout ou pour une modification d'une ligne déjà existante?

[apt]

Salut mercatog,

L'appel se fait à l'aide d'un bouton de commande sur la feuille.

- Je saisis un numéro dans le premier textbox (tbN) du formulaire.

- On fait une recherche dans la colonne A

- Si le numéro existe, alors c'est une modification (On complète les autres textbox vides)

- Si le numéro n'existe pas, c'est un ajout.

[mercatog]

Testé sur ton fichier

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
Option Explicit
Public LaLig As Long
 
Private Sub tbN_Change()
Dim LastLig As Long
Dim Str As String
Dim c As Range
 
With Worksheets("BD")
    Str = Me.tbN.Text
    If Len(Str) = 5 Then
        LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set c = .Range("A2:A" & LastLig).Find(Str, LookIn:=xlValues, lookAt:=xlWhole)
        If Not c Is Nothing Then
            LaLig = c.Row
            Set c = Nothing
            Import LaLig
        Else
            LaLig = LastLig + 1
        End If
    End If
End With
End Sub
 
'Enregistrer
Private Sub CommandButton1_Click()
 
Export LaLig
End Sub
 
'Supprimer
Private Sub CommandButton2_Click()
 
If LaLig > 1 Then
    Worksheets("BD").Rows(LaLig).Clear
    Vider
End If
End Sub
 
'Fermer
Private Sub CommandButton3_Click()
 
Unload FrmSaisie
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 
LaLig = 0
End Sub
 
'Reporter les données de la feuille BD vers les textbox
Private Sub Import(ByVal Lig As Long)
 
If Lig > 1 Then
    With Worksheets("BD")
        Me.tbTr = .Range("B" & Lig).Text
        Me.tbPr = .Range("C" & Lig).Text
        Me.tbL3 = .Range("D" & Lig).Text
        Me.tbAD = .Range("E" & Lig).Text
        Me.tbPt = .Range("F" & Lig).Text
    End With
End If
End Sub
 
'Ecrire les données dans la feuille BD dans LaLig
Private Sub Export(ByVal Lig As Long)
 
If Lig > 1 Then
    With Worksheets("BD")
        .Range("A" & Lig) = Me.tbN
        .Range("B" & Lig) = Me.tbTr
        .Range("C" & Lig) = Val(Me.tbPr)
        .Range("D" & Lig) = Val(Me.tbL3)
        .Range("E" & Lig) = Me.tbAD
        .Range("F" & Lig) = Val(Me.tbPt)
    End With
    Vider
End If
End Sub
 
'Vider les textbox
Private Sub Vider()
 
Me.tbN = ""
Me.tbTr = ""
Me.tbPr = ""
Me.tbL3 = ""
Me.tbAD = ""
Me.tbPt = ""
LaLig = 0
End Sub

[apt]

Re,

Ca marche, merci.

Mais pour le bouton « Annuler Saisie », j'aimerais ne supprimer que ce que j'ai saisis.

Si j'ai saisis deux valeurs, "Annuler Saisie" m'effacerais ces deux derniers seulement.

Elle effacera une ligne complète, si c'était un ajout.

J'ai essayé avec cela mais ca n'a pas marché :

Code :

1
2
3
4
5
6
7
8
'--- Supprimer ---
Private Sub CommandButton2_Click()
 
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
 
End Sub

[mercatog]

Si tu veux annuler les saisies effectuées dans ton usf ( avant leur enregistrement dans ta feuille) il suffit de rappeler la sub Import

Code :

1
2
3
4
5
'Annuler
Private Sub CommandButton2_Click()
 
If LaLig > 1 Then Import LaLig
End Sub

[apt]

Bonjour mercatog,

Et si on veut annuler la saisie déja enregistrée sur la feuille ?

[mercatog]

Il suffit d'effacer les 2 dernières textebox et d'enregistrer.

[apt]

Bonsoir,

J'ai ajouté deux variables globales.

TypeEntree qui sert à déterminer le type d'effacement.

TypeEntree = 1 ==> Effacer les deux dernières valeurs (tbAD, tbPt ou Ex, Fx)

TypeEntree = 2 ==> Effacer les 6 valeurs des Textbox dans le formulaire ou toute la ligne Ax,Fx

Annu qui sert à déterminer l'emplacement d'effacement

Annu = 1 ==> Effacer les Textbox avant qu'elles soient enregistrées

Annu = 2 ==> Effacer la ligne ajoutée après enregistrement.

Mais ça ne marche pas encore

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
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
Option Explicit
Public LgSaisie As Integer
Public LaLig As Long
Public TypeEntree As Integer    'sert à déterminer le type d'effacement
Public Annu As Integer    'determine l'annulation ou non
 
Private Sub UserForm_Initialize()
 
'initialiser les champs
    tbN.Text = ""
    tbTr.Text = "Tr."
    tbPr.Text = "Pr"
    tbL3.Text = "L3-"
    tbAD.Text = ""
    tbPt.Text = "Pt"
 
    Call AfficheBoutons
 
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    LaLig = 0
    TypeEntree = 0
    Annu = 0
End Sub
 
'Enregistrer
Private Sub bEnregistrer_Click()
    Annu = 2    'effacement depuis la feuille BD
    Export LaLig
End Sub
 
'--- Supprimer ---
Private Sub bAnnuler_Click()
 
    Select Case Annu
    Case 1    ' effacement des champs du formulaire
        Select Case TypeEntree
        Case 1: Range("E" & LaLig & ":F" & LaLig).ClearContents
        Case 2: Range("A" & LaLig & ":F" & LaLig).ClearContents
        End Select
    Case 2    'effacement de la rangée saisie
        Select Case TypeEntree
        Case 1
            tbAD.Text = ""
            tbPt.Text = "Pt"
        Case 2
            tbN.Text = ""
            tbTr.Text = "Tr."
            tbPr.Text = "Pr"
            tbL3.Text = "L3-"
            tbAD.Text = ""
            tbPt.Text = "Pt"
        End Select
    End Select
 
 
End Sub
 
'--- Fermer ---
Private Sub bQuitter_Click()
    Unload FrmSaisie
End Sub
 
Private Sub tbN_Change()
    Dim LastLig As Long
    Dim Str As String
    Dim c As Range
 
    TypeEntree = 0    ' ne rien faire
    Annu = 1    'effacement des textbox
    With Worksheets("BD")
        Str = Me.tbN.Text
        If Len(Str) = 5 Then
            LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
            Set c = .Range("A2:A" & LastLig).Find(Str, LookIn:=xlValues, lookAt:=xlWhole)
            If Not c Is Nothing Then
                LaLig = c.Row
                TypeEntree = 1    'Mise à jour
                Set c = Nothing
                Import LaLig
            Else
                LaLig = LastLig + 1
                TypeEntree = 2    ' Ajout
            End If
        End If
    End With
 
End Sub
 
Private Sub tbN_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        With tbTr
            .Text = "T"
            .SelStart = Len(.Text)
            .SetFocus
        End With
    End If
End Sub
 
Private Sub tbTr_Change()
    Dim Texte As String
 
    Texte = tbTr.Text
    If Len(Texte) = 4 Then Texte = Texte & "-"
    tbTr.Text = Texte
End Sub
 
Private Sub tbTr_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim Texte As String
 
    Texte = tbTr.Text
    If Len(Texte) = 4 Then Texte = Texte & "-"
    tbTr.Text = Texte
 
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        With tbPr
            .Text = ""
            .SetFocus
        End With
    End If
End Sub
 
Private Sub tbTr_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    tbTr.Text = "T"
End Sub
 
Private Sub tbPr_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        With tbL3
            .Text = "L3-"
            .SelStart = Len(.Text)
            .SetFocus
        End With
    End If
End Sub
 
Private Sub tbPr_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    tbPr.Text = ""
End Sub
 
Private Sub tbAD_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then
        With tbPt
            .Text = ""
            .SetFocus
        End With
    End If
End Sub
 
Private Sub tbPt_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    tbPt.Text = ""
End Sub
 
Private Sub tbPt_Change()
    AfficheBoutons
End Sub
 
'Reporter les données de la feuille BD vers les textbox
Private Sub Import(ByVal Lig As Long)
 
    If Lig > 1 Then
        With Worksheets("BD")
            Me.tbTr = .Range("B" & Lig).Text
            Me.tbPr = .Range("C" & Lig).Text
            Me.tbL3 = .Range("D" & Lig).Text
            Me.tbAD = .Range("E" & Lig).Text
            Me.tbPt = .Range("F" & Lig).Text
        End With
    End If
End Sub
 
'Ecrire les données dans la feuille BD dans LaLig
Private Sub Export(ByVal Lig As Long)
 
    If Lig > 1 Then
        With Worksheets("BD")
            .Range("A" & Lig) = Me.tbN
            .Range("B" & Lig) = Me.tbTr
            .Range("C" & Lig) = Val(Me.tbPr)
            .Range("D" & Lig) = Val(Me.tbL3)
            .Range("E" & Lig) = Me.tbAD
            .Range("F" & Lig) = Val(Me.tbPt)
        End With
        Vider
    End If
End Sub
 
'Vider les textbox
Private Sub Vider()
 
    Me.tbN = ""
    Me.tbTr = "Tr."
    Me.tbPr = ""
    Me.tbL3 = "L3-"
    Me.tbAD = ""
    Me.tbPt = "Pt"
    LaLig = 0
End Sub
 
Private Sub AfficheBoutons()
 
    If Val(tbPt.Value) > 0 And Len(tbPt.Value) = 3 Then
        bAnnuler.Enabled = True
        bEnregistrer.Enabled = True
    Else
        bAnnuler.Enabled = False
        bEnregistrer.Enabled = False
        Annu = 0
    End If
End Sub

EDIT :

Le reste du code ici :

http://www.developpez.net/forums/d11...n/#post6420967

[apt]

Bonsoir mercatog,

pourquoi avoir utiliser ByVal dans la procédure Import et export ?

Signifie-t-elle la valeur numérique ?

Code :

Private Sub Import(ByVal Lig As Long)

Merci.

[kiki29]

Salut, pour cela voir http://silkyroad.developpez.com/VBA/LesVariables/#LIV

[apt]

bonjour kiki29,

Merci pour l'information.