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
| Option Explicit
Private Function Adresse(ByVal Hr As String, ByVal Info As String, Optional App As Boolean) As String
Dim c As Range
Dim Lig As Integer, Col As Integer
If Hr <> "" Then
Set c = [PLAGE].Find(Hr, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Lig = c.Row
Set c = Nothing
If Info <> "" Then
Set c = IIf(App, [LSTAPPELANT], [LSTFILE]).Find(Dimin(Info), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Col = c.Column
Set c = Nothing
Adresse = Cells(Lig, Col).Address
End If
End If
End If
End If
End Function
Private Function Dimin(ByVal Str As String) As String
Dimin = Str
On Error Resume Next
Dimin = Switch(Str = "Famille", "F", Str = "Personne concernée", "C", Str = "Personnel soignant", "M", Str = "Prescripteur", "T", Str = "Polluant", "P", Str = "E-Mut", "E")
On Error GoTo 0
End Function
Private Sub Modifier(Optional Ajout As Boolean)
Dim OuAjouterFile As String, OuAjouterAppelant As String
OuAjouterFile = Adresse([HEURE], [FILE])
OuAjouterAppelant = Adresse([HEURE], [APPELANT], True)
With Worksheets("Feuil1")
If OuAjouterFile <> "" Then .Range(OuAjouterFile) = Val(.Range(OuAjouterFile)) + IIf(Ajout, 1, -1)
If OuAjouterAppelant <> "" Then .Range(OuAjouterAppelant) = Val(.Range(OuAjouterAppelant)) + IIf(Ajout, 1, -1)
[HEURE] = ""
[FILE] = ""
[APPELANT] = ""
End With
End Sub
Sub Ajouter()
Modifier True
End Sub
Sub Supprimer()
Modifier
End Sub |
