Userform-doublon et modification

**Jolefranc** · 17/04/2019, 18h52

Bonjour chers membres de ce forum
je suis entrain de construire un état de recouvrement où le paiement peut se faire en trois tranches avec un numéro de reçu à chaque paiement.
Mais étant débutant en VBA j'ai quelques difficultés par rapport à la détection des doublons éventuels au niveau des numéros de reçus à partir du userform:
-les cellules vides sont considérés comme des numéros de reçu
-les anciens numéros de reçu considérés comme doublons.
Voici le code et le fichier. Merci d'avance

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
Private Sub UserForm_Initialize()
Feuil1.Activate
UserForm1.ComboBox1.SetFocus
End Sub
 
Private Sub ComboBox1_Change()
    'Recherche du NOM, Numéro d'ordre et Classe de l'élève
    If Not ComboBox1.Value = "" Then
    Dim no_ligne As Integer
    no_ligne = ComboBox1.ListIndex + 6
    TextBox1.Value = Cells(no_ligne, 6).Value    'N°
    TextBox2.Value = Cells(no_ligne, 6).Value    'N°
    TextBox16.Value = Cells(no_ligne, 7).Value   'Classe
    Else
     MsgBox ("Ce Nom de l'élève n'existe pas")
    End If
End Sub
Private Sub TextBox2_Change()
On Error GoTo 1
     'RechercheV pour renseigner les les champs
        If WorksheetFunction.CountIf(Sheets("Etats").Range("F6:F85"), UserForm1.TextBox2.Value) = 0 Then
        MsgBox "Ce Nom n'existe pas. Veuillez ressaisir un nouveau Nom", vbInformation + vbOKOnly, "Elève non retrouvé"
        End If
    With UserForm1
        .TextBox3 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 3, 0)    'NOM Prénoms
        .ComboBox2 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 4, 0)   'Sexe
        .TextBox4 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 6, 0)    'Montant dû
        .TextBox5 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 7, 0)    '1er Vers
        .TextBox6 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 8, 0)    '2è Vers
        .TextBox7 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 9, 0)    '3è Vers
        .TextBox8 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 10, 0)   'Total Payé
        .TextBox9 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 11, 0)   'Reste à payer
        .TextBox10 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 12, 0)  'N°reçu 1
        .TextBox11 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 13, 0)  'N°reçu 2
        .TextBox12 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 14, 0)  'N°reçu 3
        .ComboBox3 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 5, 0)   'Statut
        .TextBox15 = Application.WorksheetFunction.VLookup(CLng(UserForm1.TextBox2), Sheets("Etats").Range("Source_GP1"), 15, 0)  'Observation
    End With
1
End Sub
Private Sub CommandButton2_Click()
'Bouton Modifier
    Dim modif As Integer
    'Pour obliger la saisie des numéros des reçus
If Len(UserForm1.TextBox5) <> 0 And Len(UserForm1.TextBox10) = 0 Then
    MsgBox ("Veuillez saisir le numero du reçu 1")
    UserForm1.TextBox10.SetFocus
ElseIf Len(UserForm1.TextBox6) <> 0 And Len(UserForm1.TextBox11) = 0 Then
    MsgBox ("Veuillez saisir le numero du reçu 2")
    UserForm1.TextBox11.SetFocus
ElseIf Len(UserForm1.TextBox7) <> 0 And Len(UserForm1.TextBox12) = 0 Then
    MsgBox ("Veuillez saisir le numero du reçu 3")
    UserForm1.TextBox12.SetFocus
Else
    'Vérification des doublons
    For i = 6 To 7205
    If Cells(i, 17).Text = TextBox10.Text Or Cells(i, 18).Text = TextBox10.Text Or Cells(i, 19).Text = TextBox10.Text And Cells(i, 17) <> "" Then
    MsgBox "Ce numéro de reçu est déjà attribué à " & Cells(i, 8).Value & " de la " & Cells(i, 7).Value, vbInformation + vbOKOnly, "Doublon numéro reçu"
    TextBox10.Text = " "
    TextBox10.SetFocus
    Exit Sub
    ElseIf Cells(i, 17).Text = TextBox11.Text Or Cells(i, 18).Text = TextBox11.Text Or Cells(i, 19).Text = TextBox11.Text And Cells(i, 18) <> "" Then
    MsgBox "Ce numéro de reçu est déjà attribué à " & Cells(i, 8).Value & " de la " & Cells(i, 7).Value, vbInformation + vbOKOnly, "Doublon numéro reçu"
    TextBox11.Text = " "
    TextBox11.SetFocus
    Exit Sub
    ElseIf Cells(i, 17).Text = TextBox12.Text Or Cells(i, 18).Text = TextBox12.Text Or Cells(i, 19).Text = TextBox12.Text And Cells(i, 19) <> "" Then
    MsgBox "Ce numéro de reçu est déjà attribué à " & Cells(i, 8).Value & " de la " & Cells(i, 7).Value, vbInformation + vbOKOnly, "Doublon numéro reçu"
    TextBox12.Text = " "
    TextBox12.SetFocus
    Exit Sub
    End If
    Next i
 
    'Enregistrement des modifications
    If ComboBox1.Value <> "" Then
    Sheets("Etats").Select
    modif = ComboBox1.ListIndex + 6
    Cells(modif, 9) = ComboBox2.Value       'Sexe
    Cells(modif, 10) = ComboBox3.Value      'Statut
    Cells(modif, 12) = TextBox5.Value       '1er Vers
    Cells(modif, 13) = TextBox6.Value       '2è Vers
    Cells(modif, 14) = TextBox7.Value       '3è Vers
    Cells(modif, 17) = TextBox10.Value      'N°Reçu 1
    Cells(modif, 18) = TextBox11.Value      'N°Reçu 2
    Cells(modif, 19) = TextBox12.Value      'N°Reçu 3
    Cells(modif, 20) = TextBox15.Value      'Observation
    MsgBox ("Modification effectuée avec succès")
    Else
    MsgBox ("Veuillez sélectionner le Nom de l'élève à modifier")
    Exit Sub
    End If
 
    'Pour mettre les noms de filles en gras
    For r = 6 To 85
    If Cells(r, 9).Value = "F" Then
    Cells(r, 8).Select
    Selection.Font.Bold = True
    Else
    Cells(r, 8).Select
    Selection.Font.Bold = False
    End If
    Next r
    Cells(6, 8).Select
    Unload UserForm1
    UserForm1.Show
End If
End Sub
Private Sub CommandButton3_Click()
Unload UserForm1
    Feuil6.Activate
    Range("A1").Select
End Sub
Private Sub TextBox9_Change()
If TextBox9.Value = 0 Then
    TextBox13.Value = "Soldé"
    Else: TextBox13.Value = " "
    End If
End Sub
Private Sub CommandButton4_Click()
'Bouton Ajouter
If TextBox3.Value = "" Then
    MsgBox "Veuillez renseigner le champ 'NOM Prénoms'"
Else
Dim ligne As Integer
    If MsgBox("Confirmez-vous l'ajout des données?", vbYesNo, "Conirmation") = vbYes Then
    Worksheets("Etats").Select
    ligne = Sheets("Etats").Range("H85").End(xlUp).Row + 6
        Cells(ligne, 8) = TextBox3.Value
        Cells(ligne, 9) = ComboBox2.Value
        Cells(ligne, 10) = ComboBox3.Value
    End If
'Pour mettre les noms de filles en gras
For r = 6 To 85
 If Cells(r, 9).Value = "F" Then
    Cells(r, 8).Select
    Selection.Font.Bold = True
Else
    Cells(r, 8).Select
    Selection.Font.Bold = False
End If
Next r
Cells(6, 8).Select
End If
    Range("H6:T85").Select
    ActiveWorkbook.Worksheets("Etats").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Etats").Sort.SortFields.Add Key:=Range("H6"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Etats").Sort
        .SetRange Range("H6:T85")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    Range("H6").Select
    End With
    Unload UserForm1
    UserForm1.Show
End Sub

Userform-doublon et modification

Macros et VBA Excel

Mode arborescent

Discussions similaires

Partager

Partager