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
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
| Option Explicit
' Déclaration des variables et constantes de portées module
Enum Status ' Constantes énumérées Status
Consultation = 0: Modify = 1: NewRec = 2: Remove = 3
End Enum
Const StatusLabel As String = "Consultation;Modification;Création;Suppression"
Const appTitle As String = "Musar Fra C - gestion des agents"
Dim UserFormStatus As Byte ' Statut du type de travail (Consultation, Modify, NewRec, Remove)
Dim CurrentRecord As Long ' Enregistrement en cours
Dim rng As Range ' Plage de données traitée par le formulaire
Dim lstStatusText() As String
Private Sub UserForm_Activate()
InitVariable ' Initialisation des variables
InitData ' Initialisation adresse liste des données + RowSource
InitComboBox ' Initialisation ComboBox
UserFormStatus = Status.Consultation ' Consultation par défaut
With Me ' Initialisation de certains contrôles
.cmdConfirm.Visible = False: .cmdCancel.Visible = False
.cboMember.Enabled = True: .frmMember.Enabled = False
usfTitle ' Titre du UserForm (Propriété Caption)
End With
' Focus sur le 1er enregistrement ou l'enregistrement sélectionné dans la feuille
With Me: .cboMember.ListIndex = Me.Tag: End With
End Sub
Private Sub InitVariable()
lstStatusText = Split(StatusLabel, ";")
With Me
.optMale.GroupName = "Gender": Me.optFemale.GroupName = "Gender"
If Len(.Tag) = 0 Then .Tag = 0
End With
End Sub
Private Sub InitComboBox()
With Me.cboMember
.ColumnHeads = True: .ColumnCount = 10: .ColumnWidths = "0;0;0;90;90;0;0;0;15;0"
End With
InitRowSource '
End Sub
Private Sub InitData()
' Redimensionnement de l'objet rng et RowSource
Set rng = Feuil1.Range("B1").CurrentRegion
With rng
Set rng = .Offset(1).Resize(.Rows.Count - 1)
End With
End Sub
Private Sub InitRowSource()
With Me.cboMember
.RowSource = rng.Address(external:=True)
.ListIndex = 0 ' Force la sélection du premier enregistrement
End With
End Sub
Private Sub cboMember_Click()
CurrentRecord = Me.cboMember.ListIndex
ReadRecord CurrentRecord ' Lecture de l'enregistrement sélectionné
CheckButton
End Sub
Private Sub cmdCancel_Click()
ReadRecord CurrentRecord
OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
Private Sub cmdConfirm_Click()
Select Case UserFormStatus
Case Status.NewRec ' Nouvel enregistrement
WriteRecord rng.Rows.Count: InitData: InitRowSource
Me.cboMember.ListIndex = rng.Rows.Count - 1
Case Status.Modify: WriteRecord CurrentRecord ' Modification de l'enregistrement
End Select
OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
Private Sub cmdExit_Click()
Unload Me ' Fermeture du UserForm
End Sub
Private Sub cmdModify_Click()
UserFormStatus = Status.Modify
OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
Private Sub cmdNew_Click()
UserFormStatus = Status.NewRec
ClearTextBox ' Efface les valeurs des TextBox
OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
Private Sub ClearTextBox()
' Efface toutes les valeurs contenues dans les contrôles TextBox du frame nommé frmMember
Dim Ctrl As Control
For Each Ctrl In Me.frmMember.Controls
If TypeOf Ctrl Is MSForms.TextBox Then Ctrl.Value = ""
Next
End Sub
Private Sub RemoveRecord(ByVal RecordNumber As Long)
' Suppression de l'enregistrement
' Contrainte : il doit rester un enregistrement
Select Case True
Case rng.Rows.Count = 1 ' Reste 1 enregistrement
MsgBox "Vous devez laisser un enregistrement", vbInformation, "Suppression impossible"
Case MsgBox("Voulez-vous supprimer la ligne sélectionnée", _
vbCritical + vbYesNo + vbDefaultButton2, _
"Suppression de la ligne " & CurrentRecord + 1) = vbYes
RecordNumber = RecordNumber + 1
rng.Rows(RecordNumber).Delete Shift:=xlUp ' Supprime la ligne de la plage
InitData ' Initialisation des variables objets
InitRowSource ' Initialisation de la propriété RowSource
CurrentRecord = 0: Me.cboMember.ListIndex = CurrentRecord
End Select
UserFormStatus = Status.Consultation
End Sub
Private Sub cmdNext_Click()
Me.cboMember.ListIndex = CurrentRecord + 1
End Sub
Private Sub cmdPrevious_Click()
Me.cboMember.ListIndex = CurrentRecord - 1
End Sub
Private Sub cmdFirst_Click()
Me.cboMember.ListIndex = 0
End Sub
Private Sub cmdLast_Click()
Me.cboMember.ListIndex = rng.Rows.Count - 1
End Sub
Private Sub cmdRemove_Click()
UserFormStatus = Status.Remove: usfTitle
RemoveRecord CurrentRecord ' Supprime l'enregistrement courant
UserFormStatus = Status.Consultation: usfTitle
End Sub
Private Sub ReadRecord(ByVal RecordNumber As Long)
' Lecture de l'enregistrement
RecordNumber = RecordNumber + 1
With rng
Me.txtMatricule = .Cells(RecordNumber, 9)
Me.txtName = .Cells(RecordNumber, 4)
Me.txtFonction = .Cells(RecordNumber, 5)
Me.txtVisite = .Cells(RecordNumber, 8)
If UCase(.Cells(RecordNumber, 10)) = "F" Then Me.optFemale.Value = True Else Me.optMale = True
Me.frmMember.Caption = "Fiche " & Format(RecordNumber, "R000")
End With
End Sub
Private Sub WriteRecord(ByVal RecordNumber As Long)
' Ecriture de l'enregistrement
Me.cboMember.ListIndex = -1
RecordNumber = RecordNumber + 1
With rng
With .Cells(RecordNumber, 1)
If Len(.Value) = 0 Then ' ID
.Value = Application.WorksheetFunction.Max(rng.Columns(1)) + 1
End If
.NumberFormat = "\R000" ' Format
End With
.Cells(RecordNumber, 9) = Me.txtMatricule
.Cells(RecordNumber, 4) = Me.txtName
.Cells(RecordNumber, 5) = Me.txtFonction
.Cells(RecordNumber, 8) = Me.txtVisite
.Cells(RecordNumber, 10) = IIf(Me.optFemale = True, "F", "M")
End With
Me.cboMember.ListIndex = CurrentRecord
End Sub
Sub OppositeStatus()
' Inverse la valeur booléenne des boutons d'action
' Modifie la propriété Caption du UserForm
With Me
.cboMember.Enabled = Not .cboMember.Enabled
.frmMember.Enabled = Not .frmMember.Enabled
.frmAction.Visible = Not .frmAction.Visible
.cmdCancel.Visible = Not .cmdCancel.Visible
.cmdConfirm.Visible = Not .cmdConfirm.Visible
.cmdExit.Visible = Not .cmdExit.Visible
.frmNavigation.Visible = Not .frmNavigation.Visible
If .cboMember.Enabled = True Then UserFormStatus = Status.Consultation ' Consultation
usfTitle ' Titre du UserForm
End With
End Sub
Private Function usfTitle()
' Modifie la propriété Caption du UserForm
Me.Caption = appTitle & " - " & lstStatusText(UserFormStatus)
End Function
Sub CheckButton()
With Me
.cmdFirst.Enabled = CurrentRecord > 0
.cmdPrevious.Enabled = CurrentRecord > 0
.cmdNext.Enabled = CurrentRecord <> rng.Rows.Count - 1
.cmdLast.Enabled = CurrentRecord <> rng.Rows.Count - 1
End With
End Sub
Private Sub UserForm_Terminate()
Set rng = Nothing
MsgBox "Bye, bye"
End Sub
Private Sub UserForm_Initialize()
Dim f As Worksheet
Dim Lr As Long
Dim Ligne As Integer
Dim w As Variant
Set f = ThisWorkbook.Sheets("Cfg")
With LtvPers
.ListItems.Clear
With .ColumnHeaders
.Clear
.Add , , "Réf.", 25, lvwColumnLeft
.Add , , "Id's", 1, lvwColumnCenter
.Add , , "Nom, Prénom", 120, lvwColumnLeft
.Add , , "Fonction", 100, lvwColumnLeft
.Add , , "Date début de mission", 1, lvwColumnCenter
.Add , , "Date fin de mission", 1, lvwColumnCenter
.Add , , "Visite médicale", 68, lvwColumnCenter
.Add , , "Matricule", 45
.Add , , "Sexe", 30
End With
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
End With
Lr = Range("B" & Rows.Count).End(xlUp).Row
If Lr = 2 Then Exit Sub
Ligne = 1
For Each w In f.Range("B2:B" & Lr)
.ListItems.Add , , w
.ListItems(Ligne).ListSubItems.Add , , w.Offset(, 1)
.ListItems(Ligne).ListSubItems.Add , , w.Offset(, 2)
.ListItems(Ligne).ListSubItems.Add , , w.Offset(, 3)
.ListItems(Ligne).ListSubItems.Add , , w.Offset(, 4)
.ListItems(Ligne).ListSubItems.Add , , w.Offset(, 5)
.ListItems(Ligne).ListSubItems.Add , , w.Offset(, 6)
.ListItems(Ligne).ListSubItems.Add , , w.Offset(, 7)
.ListItems(Ligne).ListSubItems.Add , , w.Offset(, 8)
Ligne = Ligne + 1
Next w
lblNbReg.Caption = LtvPers.ListItems.Count
Set f = Nothing
End Sub |
