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
| Function RechercherLigne(Nom As String, Prenom As String) As Long
Dim Plage As Range
Dim Cel As Range
Dim Adr As String
Dim Message As String
'sur la feuille "Feuil1" en colonne A à partire de A3 <-- à adapter...
With Worksheets(Me.txtSection.Value)
Set Plage = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
'défini le message par défaut
Message = "'" & Nom & " " & Prenom & "' n'existe pas dans la base de données !"
'effectue la recherche exacte du nom
Set Cel = Plage.Find(Nom, , xlValues, xlWhole)
'si trouvé, compare le prénom. Si le prénom correspond aussi, change le message
If Not Cel Is Nothing Then
Adr = Cel.Address
Do
If Cel.Offset(, 1).Value = Prenom Then
LigEx = Cel.Row
Exit Do
End If
Set Cel = Plage.FindNext(Cel)
Loop While Adr <> Cel.Address
End If
'retourne le message
RechercherLigne = LigEx
End Function
Private Sub CmdEnregistrer_Click()
Dim section As String
Dim mois As String
Dim Lig As Integer, LigE As String, LigEx As Integer
Dim Nom As String, Prenom As String
Dim ligne As Long
'Controle du remplissage de toutes les données
If Me.txtSection.Value = "" Then
MsgBox "Vous devez entrer une section. Merci"
Me.txtSection.SetFocus
Exit Sub
End If
'...
'Remplissage de la feuille de la section concerné
'recherche si la personne existe déjà
ligne = RechercherLigne(TxtNom, TxtPrenom)
If ligne > 0 Then
'si la personne existe le tableau se remplit comme suit
'Information sur les cheques
mois = Me.TxtMois.Value
If mois = "Septembre" Then
With Sheets(Me.txtSection.Value)
.Range("F" & ligne).Value = Me.TxtMontant.Value
.Range("G" & ligne).Value = Me.txtNumeroCheque.Value
End With
End If
If mois = "Octobre" Then
With Sheets(Me.txtSection.Value)
.Range("H" & ligne).Value = Me.TxtMontant.Value
.Range("I" & ligne).Value = Me.txtNumeroCheque.Value
End With
End If
'il faut faire de meme pour les autres mois en changeant les .Range()
Else
'Si la personne n'existe pas le tableau se remplit comme suit...
'selection de la bonne feuille section
With Sheets(Me.txtSection.Value)
'recupération du numero de la Premiere ligne vide dans la feuille de la section concernée
Lig = .Range("A300").End(xlUp).Row
Lig = Lig + 1
'information sur les personnes
.Range("A" & Lig).Value = Me.TxtNom.Value
.Range("B" & Lig).Value = Me.TxtPrenom.Value
.Range("C" & Lig).Value = Me.TxtNomCheque.Value
.Range("D" & Lig).Value = Me.TxtBanque.Value
End With
'Information sur les cheques
mois = Me.TxtMois.Value
If mois = "Septembre" Then
With Sheets(Me.txtSection.Value)
.Range("F" & Lig).Value = Me.TxtMontant.Value
.Range("G" & Lig).Value = Me.txtNumeroCheque.Value
End With
End If
End If
'il faut faire de meme pour les autres mois en changeant les .Range()
'Inscription du cheques dans la feuille "Recap"
With Sheets("Recap")
.Range("A300").End(xlUp).Offset(1, 0).Value = Me.txtSection.Value
.Range("B300").End(xlUp).Offset(1, 0).Value = Me.TxtNom.Value
.Range("C300").End(xlUp).Offset(1, 0).Value = Me.TxtPrenom.Value
.Range("D300").End(xlUp).Offset(1, 0).Value = Me.TxtNomCheque.Value
.Range("E300").End(xlUp).Offset(1, 0).Value = Me.TxtBanque.Value
.Range("F300").End(xlUp).Offset(1, 0).Value = Me.TxtMontant.Value
.Range("G300").End(xlUp).Offset(1, 0).Value = Me.txtNumeroCheque.Value
.Range("H300").End(xlUp).Offset(1, 0).Value = TxtMois.Value
End With
End Sub |
Extraction de données de plusieurs feuilles et du nom de la feuille
Répondre avec citation
Envoyé par sebastien-16600
Partager