Comment améliorer mon code pour ajout et modification de user code

Version imprimable

Salut le forum

J'ai un usf contenant 3 codes qui me permet d'ajouter ou de modifier les données d'un user:
- le premier me permet d'ajouter un nouvel utilisateur s'il s'agit d'un nouvel user
- le deuxième me permet d'afficher les données d'un utilisateur en vu de leur modification
- le troisième me permet de valider la modification
Je constate que lorsque je renseigne un code qui n'existe pas dans la plage des codes utilisateurs, il y'a une erreur qui se produit.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub bt_add_Click()
Dim P As Object 'déclare la variable P (onglet Parametre)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim I As Integer 'déclare la variable I (Incrément)
 
Set P = Sheets("PARAMETRE") 'définit l'onglet P
DL = P.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 2 (=B) de l'onglet P
Set PL = P.Range("B2:B" & DL) 'définit la plage PL
'verification des identifiants
If Application.WorksheetFunction.CountIf(PL, TextBox1.Value) > 0 Then
    MsgBox ("Ce user est déjà enregistré")
    Exit Sub
End If
For I = 1 To 6 'boucle sur les 6 textboxes
    'envoie la valeur de la textbox dans la cellule ligne DL+1, colonne I+1 de l'onglet P
    P.Cells(DL + 1, I + 1).Value = Me.Controls("TextBox" & I).Value
    Me.Controls("TextBox" & I).Value = ""
Next I
End Sub

Code:

1
2
3
4
5
6
7
8
Private Sub TextBox1_AfterUpdate()
   laligne = Application.Match(Me.TextBox1.Value, Sheets("PARAMETRE").[B1:B200], 0)
    Me.TextBox2 = Sheets("PARAMETRE").Cells(laligne, 3)
    Me.TextBox3 = Sheets("PARAMETRE").Cells(laligne, 4)
    Me.TextBox4 = Sheets("PARAMETRE").Cells(laligne, 5)
    Me.TextBox5 = Sheets("PARAMETRE").Cells(laligne, 6)
    Me.TextBox6 = Sheets("PARAMETRE").Cells(laligne, 7)
End Sub

Code:

1
2
3
4
5
6
7
8
Private Sub bt_modif_Click()
    Sheets("PARAMETRE").Cells(laligne, 2) = Me.TextBox1
    Sheets("PARAMETRE").Cells(laligne, 3) = Me.TextBox2
    Sheets("PARAMETRE").Cells(laligne, 4) = Me.TextBox3
    Sheets("PARAMETRE").Cells(laligne, 5) = Me.TextBox4
    Sheets("PARAMETRE").Cells(laligne, 6) = Me.TextBox5
    Sheets("PARAMETRE").Cells(laligne, 7) = Me.TextBox6
End Sub

27/08/2014, 12h53
Invité

Bonjour,

ce serait plus facile avec un fichier car pour tester il faut redessiner le UF!
bidonnes les données confidentielles et zip le fichier si c'est du xlsm!
27/08/2014, 13h19
capi81

Merci pour le feedback.
Ci-dessous le lien du fichier
http://cjoint.com/?DHBnugZknjI

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
 
Public laligne As Integer
 
Private Sub bt_add_Click()
Dim P As Object 'déclare la variable P (onglet Parametre)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim I As Integer 'déclare la variable I (Incrément)
 
Set P = Sheets("PARAMETRE") 'définit l'onglet P
DL = P.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 2 (=B) de l'onglet P
Set PL = P.Range("B2:B" & DL) 'définit la plage PL
'verification des identifiants
If Application.WorksheetFunction.CountIf(PL, TextBox1.Value) > 0 Then
    MsgBox ("Ce user est déjà enregistré")
    Exit Sub
End If
For I = 1 To 6 'boucle sur les 6 textboxes
    'envoie la valeur de la textbox dans la cellule ligne DL+1, colonne I+1 de l'onglet P
    P.Cells(DL + 1, I + 1).Value = Me.Controls("TextBox" & I).Value
    Me.Controls("TextBox" & I).Value = ""
Next I
End Sub
 
Private Sub bt_modif_Click()
If SerchXls(Sheets("PARAMETRE").Range("b:b"), Sheets("PARAMETRE").[B1], Me.TextBox1.Value, True) = 0 Then MsgBox "N'existe pas": Exit Sub
    Sheets("PARAMETRE").Cells(laligne, 2) = Me.TextBox1
    Sheets("PARAMETRE").Cells(laligne, 3) = Me.TextBox2
    Sheets("PARAMETRE").Cells(laligne, 4) = Me.TextBox3
    Sheets("PARAMETRE").Cells(laligne, 5) = Me.TextBox4
    Sheets("PARAMETRE").Cells(laligne, 6) = Me.TextBox5
    Sheets("PARAMETRE").Cells(laligne, 7) = Me.TextBox6
End Sub
 
Private Sub bt_suppr_Click()
If Trim("" & Me.TextBox1) = "" Then MsgBox "Vous devez saisire…": Exit Sub
If MsgBox("Etes vous sur de vouloir supprimer : " & Me.TextBox1, vbQuestion + vbYesNo) = vbNo Then Exit Sub
laligne = SerchXls(Sheets("PARAMETRE").Range("b:b"), Sheets("PARAMETRE").[B1], Me.TextBox1.Value, True)
If laligne = 0 Then Exit Sub
Sheets("PARAMETRE").Rows(laligne).Delete
    Me.TextBox1 = ""
    Me.TextBox2 = ""
    Me.TextBox3 = ""
    Me.TextBox4 = ""
    Me.TextBox5 = ""
    Me.TextBox6 = ""
End Sub
 
Private Sub CommandButton1_Click()
Unload Me
End Sub
 
Private Sub TextBox1_AfterUpdate()
laligne = SerchXls(Sheets("PARAMETRE").Range("b:b"), Sheets("PARAMETRE").[B1], Me.TextBox1.Value, True)
If laligne = 0 Then
    Me.TextBox2 = ""
    Me.TextBox3 = ""
    Me.TextBox4 = ""
    Me.TextBox5 = ""
    Me.TextBox6 = ""
Else
  ' laligne = Application.Match(Me.TextBox1.Value, Sheets("PARAMETRE").[B1:B200], 0)
    Me.TextBox2 = Sheets("PARAMETRE").Cells(laligne, 3)
    Me.TextBox3 = Sheets("PARAMETRE").Cells(laligne, 4)
    Me.TextBox4 = Sheets("PARAMETRE").Cells(laligne, 5)
    Me.TextBox5 = Sheets("PARAMETRE").Cells(laligne, 6)
    Me.TextBox6 = Sheets("PARAMETRE").Cells(laligne, 7)
End If
End Sub
 
Private Sub UserForm_Click()
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
Function SerchXls(Myrange As Range, MyCellule As Range, strRecherche, EntierCell As Boolean) As Long '
On Error Resume Next
Dim CellEntrier As Integer
If EntierCell = True Then CellEntrier = xlWhole Else CellEntrier = xlPart
SerchXls = 0
   SerchXls = Myrange.Cells.Find(what:=strRecherche, After:=MyCellule, LookIn:=xlFormulas, LookAt _
        :=CellEntrier, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=EntierCell).Row
  If SerchXls <= MyCellule.Row Then SerchXls = 0
End Function

27/08/2014, 14h16
capi81

Votre solution est géniale.
Tout fonctionne bien.
Pour éviter qu'un utilisateur puisse modifier les données d'un autre, j'ai ajouter cette condition et ca fonctionne.
Encore merci pour l'assistance.
:D