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
|
'Déclaration des variables
Dim Liste, Sequence, Durée, nbCol, L, a()
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
Sub UserForm_Initialize()
Gpt.Value = (Sheets("Agents").Range("a1")) 'Groupement
Zone.Value = (Sheets("Agents").Range("b1")) 'Zone
Centre.Value = (Sheets("Agents").Range("c1")) 'Centre
nbCol = 3 'Nombre de colonnes de la liste sur la feuille Thèmes
L = 200 'Nombre de lignes dans la liste
ReDim a(1 To L, 1 To nbCol)
'Remplissage des colonnes 1 à 3 de la listbox nommée choix,
Set Liste = Sheets("Agents")
Set Thèmes = Sheets("Thèmes")
Set Durée = Sheets("Thèmes")
'Remplir la ligne jusqu'à la dernière ligne trouvée
Me.choix.List = Range(Liste.[d4], Liste.[f65000].End(xlUp)).Value ' liste des noms
Me.Sequence_pédagogique.List = Range(Thèmes.[c3], Thèmes.[c65000].End(xlUp)).Value 'liste des séquences
Me.Temps.List = Range(Thèmes.[i4], Thèmes.[i65000].End(xlUp)).Value ' liste des durées
'Option de sélection multiple
Me.choix.MultiSelect = fmMultiSelectMulti
Me.choix.ColumnCount = nbCol
Me.choix.ColumnWidths = "100;40;40"
End Sub
Private Sub cmdValider_Click()
' On teste la saisie de la dat
If Me.DateSaisie.Text = "" Then
MsgBox "Vous devez entrer une date."
Me.DateSaisie.SetFocus
Exit Sub
End If
If Not IsDate(DateSaisie.Text) Then
MsgBox "format incorrect"
DateSaisie.Text = ""
Exit Sub
End If
'On teste la saisie de l'agent
If Me.choix.Value = "" Then
MsgBox "Vous devez entrer un Nom."
Me.choix.SetFocus
Exit Sub
End If
' On teste la saisie du thémes de manoeuvres
If Me.Sequence_pédagogique.Text = "" Then
MsgBox "Vous devez entrer une Sequence pédagogique."
Me.Sequence_pédagogique.SetFocus
Exit Sub
End If
' On teste la saisie de l'agent
If Me.Temps.Value = "" Then
MsgBox "Vous devez entrer un temps de formation ."
Me.Temps.SetFocus
Exit Sub
End If
'Endroit de la feuille où remplir la base:
Dim k As Byte ' boucle sur la listbox et transfert les données contenues dans les différents controls
For k = 0 To Me.choix.ListCount - 1
If Me.choix.Selected(k) = True Then
ligne = ligne + 1
For c = 0 To nbCol - 1 'boucle sur les colonnes
a(ligne, c + 1) = Me.choix.List(k, c)
Next c
Range("a65536").End(xlUp).Offset(1, 0).Value = DateSaisie ' remplissage de la colonne date
Range("b65536").End(xlUp).Offset(1, 0).Value = DateSaisie ' remplissage de la colonne mois
Range("c65536").End(xlUp).Offset(1, 0).Value = DateSaisie ' remplissage de la colonne Année
Range("d65536").End(xlUp).Offset(1, 0).Value = Gpt ' remplissage de la colonne groupement
Range("e65536").End(xlUp).Offset(1, 0).Value = Zone ' remplissage de la colonne zone
Range("f65536").End(xlUp).Offset(1, 0).Value = Centre ' remplissage de la colonne centre
Range("J65536").End(xlUp).Offset(1, 0).Value = Module ' remplissage de la colonne module
Range("K65536").End(xlUp).Offset(1, 0).Value = Thème ' remplissage de la colonne uv
Range("L65536").End(xlUp).Offset(1, 0).Value = Sequence_pédagogique ' remplissage de la colonne Sequence
Range("M65536").End(xlUp).Offset(1, 0).Value = Temps.Value ' remplissage de la colonne temps
Range("N65536").End(xlUp).Offset(1, 0).Value = Formation.Value ' remplissage de la colonne for
Range("O65536").End(xlUp).Offset(1, 0).Value = Abs_for.Value ' remplissage de la colonne Abs for
End If
Next k 'boucle sur les colonnes
Range("g65536").End(xlUp).Offset(1, 0).Resize(UBound(a), nbCol) = a 'remplissage de la colonne grade, nom ,statut
Dim i As Variant
For Each i In Range("b5:b" & Cells(Rows.Count, "b").End(xlUp).Row) ' transformation de la date en mois
If IsDate(i) Then i = Format(i, "mmmm")
Next i
For Each i In Range("c5:c" & Cells(Rows.Count, "c").End(xlUp).Row) ' transformation de la date en Année
If IsDate(i) Then i = Format(ci, "yyyy")
Next i
Dim intRet As Integer
Dim y As Control
intRet = MsgBox("Veux tu enregistrer une nouvelle date", vbInformation + vbYesNo, " Enregistrement effectué avec succès")
If intRet = vbYes Then
'procédure si click sur Oui
'vider la combo noms
Me.choix.MultiSelect = 0
Me.choix.MultiSelect = 1
DateSaisie.Value = ""
Module.Value = ""
Thème.Value = ""
Formation.Value = ""
Abs_for.Value = ""
For Each y In Me.Controls
Select Case TypeName(y)
Case "ComboBox"
y.ListIndex = -1
End Select
Next y
Else
If intRet = vbNo Then
Me.choix.MultiSelect = 0
Me.choix.MultiSelect = 1
DateSaisie.Value = ""
Module.Value = ""
Thème.Value = ""
Formation.Value = ""
Abs_for.Value = ""
'procédure si click sur Non les combos sont vidé
For Each y In Me.Controls
Select Case TypeName(y)
Case "ComboBox"
y.ListIndex = -1
End Select
Next y
End If
inret = MsgBox("Appuie sur OK pour fermer le programme", vbCritical + vbOKOnly, " ")
If intRet = vbOKOnly Then
ActiveWorkbook.Save
End If
Unload Me
End If
End Sub
Private Sub Sequence_pédagogique_Click()
ligne = Sheets("Thèmes").[c:c].Find(Sequence_pédagogique, LookIn:=xlValues).Row
Me.Module = Sheets("Thèmes").Cells(ligne, 1)
Me.Thème = Sheets("Thèmes").Cells(ligne, 2)
Dim Tbl
Dim Tbl2
Dim x As Integer
Dim y As Integer
Dim Retour_for As Integer
Dim Retour_Abs As Integer
Tbl = Array("SAP", "OPD", "INC", "SR", "Fdf", "CAD")
For x = 0 To UBound(Tbl)
If Module.Text = Tbl(x) Then Retour_for = 1: Exit For ' renvoie 1 si la txt module est = à une valeur de la table
Next x
Formation = Retour_for
Tbl2 = Array("Abs for")
For y = 0 To UBound(Tbl2)
If Module.Text = Tbl2(y) Then Retour_Abs = 1: Exit For ' renvoie 1 si la txt module est = à une valeur de la table2
Next y
Abs_for = Retour_Abs
End Sub
Private Sub DateSaisie_Change()
Dim valeur As Byte
DateSaisie.MaxLength = 10
valeur = Len(DateSaisie)
If valeur = 2 Or valeur = 5 Then DateSaisie = DateSaisie & "/"
End Sub |
Partager