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
| Sub Mouvement(Target As Range, TypeM As String)
'Déclaration des variables
Dim VehIn As Range
Dim NomAgent As String, PrenomAgent As String
Dim Sh As Worksheet
Dim CellId As Range
Dim FirstCellAdd As String
Dim NewRow As ListRow
'On recherche la ligne de données correspondante au vehicule saisi
'(Ici jutilise le codeName de la feuille F_Donnees, il se trouve dans les propriétés de la feuille DONNEES sous l'appellation "(Name)")
Set VehIn = F_Donnees.Range("A:A").Find(what:=Target, LookIn:=xlValues, LookAt:=xlWhole)
If VehIn Is Nothing Then
'Pas de correspondance
'MsgBox "Le véhicule '" & Target.Value & "' n'est pas répertorié !", vbOKOnly + vbExclamation, "ERREUR"
'Target = ""
'On ajoute une ligne au tableau "Données" (il serait mieux de le convertir un tableau ListObject, c'est plus simple à manipuler)
Set NewRow = F_Donnees.ListObject("Tab_Donnees")....
'On renseigne le contenu, provisoirement la même chose dans les 3 cellules principales
NewRow.Range(1) = Target
NewRow.Range(2) = Target
NewRow.Range(3) = Target
'On pointe cette ligne comme correspondant à la demande
Set VehIn = NewRow.Range(1)
End If
'On ferme le If, à partir d'ici VehIn aura forcement un contenu donné soit par la recherche Find, soit par le Set en fin de boucle.
'Correspondance trouvée
'On récup le nom + prénom de l'agent
NomAgent = VehIn.Offset(, 1).Value
PrenomAgent = VehIn.Offset(, 2).Value
'On recherche si cet identifiant est déjà dans la liste
With F_Travail.ListObjects("Tab_Travail").ListColumns("Nom").DataBodyRange 'On ne prend en compte que les données de la colonne "Nom" du tableau Tab_Travail
'On fait une recherche en boucle dans la colonne "Nom"
Do
If CellId Is Nothing Then
Set CellId = .Find(NomAgent, LookIn:=xlValues, LookAt:=xlWhole)
Else
Set CellId = .FindNext(CellId)
End If
'Si on a trouvé une entrée
If Not CellId Is Nothing Then
'Si on est déjà passé par cette cellule
If CellId.Address = FirstCellAdd Then
'###Dans le cas d'une Sortie de personnel###
If TypeM = "Sortie" Then
'Un tour complet de la colonne a été fait sans trouver de correspondance
'A toi de voir comment tu veux gérer cette situation
MsgBox (NomAgent & " " & PrenomAgent & " : Personne non présente sur le site")
'###Dans le cas d'une Entrée de personnel###
Else
'On place une nouvelle ligne dans le tableau*
AjoutLigne Target, VehIn
End If
'Dans tous les cas, on sort de la pracédure
Exit Sub
End If
'Si c'est la 1ère occurence on se repère dans le tableau (pour ne pas boucler à l'infini)
If FirstCellAdd = "" Then FirstCellAdd = CellId.Address
'On regarde si le prénom correspond
If CellId.Offset(, 1).Value = PrenomAgent Then
'On concidère être sur la bonne personne
'On regarde si la sortie est renseigné
If CellId.Offset(, -1).Value = "" Then
'###Dans le cas d'une Sortie de personnel###
If TypeM = "Sortie" Then
'L'agent est bien présent dans les locaux, on idique son heure de sortie
CellId.Offset(, -1).Value = Time()
'On vide la case Sort
F_Travail.[C30].ClearContents
'###Dans le cas d'une Entrée de personnel###
Else
'Problème la personne rentre dans le site sans en être ressortie avant
'A toi de voir comment tu veux gérer cette situation
MsgBox (NomAgent & " " & PrenomAgent & " : Cet personne devrait déjà être sur le site.")
End If
'On quitte donc la boucle
Exit Do
End If 'dans le cas contraire on continue la boucle
End If
Else
'###Dans le cas d'une Sortie de personnel###
If TypeM = "Sortie" Then
'Problème la personne qui sort n'a pas été inscrite à son entrée sur le registre
'A toi de voir comment tu veux gérer cette situation
MsgBox (NomAgent & " " & PrenomAgent & " : Personne non présente sur le site")
'###Dans le cas d'une Entrée de personnel###
Else
'On place une nouvelle ligne dans le tableau*
AjoutLigne Target, VehIn
End If
'Dans tous les cas, on sort de la pracédure
Exit Sub
End If
Loop Until CellId Is Nothing
End With
End Sub |
Recupération de données
Répondre avec citation
Tutoriel :
Partager