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
| Option Explicit
Dim LigneCelluleActive As Variant
Dim Colonne_A As Variant
Dim Colonne_E As Variant
Dim Colonne_V As Variant
Dim Colonne_BE As Variant
'Sauvegarde une copie du fichier nommé: Date & la date, dans un dossier, dans le même dossier du fichier, nommé: Backup & le nom du fichier
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim chemin As String
Dim CheminSource As String
Dim CheminBackup As String
Dim DossierBackup As String
Dim CheminPublic As String
Dim MonFichier As String
Dim Nom As String
Dim NomMajuscule As String
Nom = Environ("USERNAME")
NomMajuscule = UCase(Nom) 'UCase = Mise en majuscule - LCase = minuscule - Application.proper = Nom propre
DossierBackup = "Backup " & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) 'Pour enlever le .xlsm les 5 caractères depuis la droite
CheminSource = ThisWorkbook.Path & "\" & DossierBackup & "\"
'Test si le dossier existe déjà
On Error Resume Next 'N'éxécute pas la ligne qui suit en cas d'erreur
MkDir CheminSource
On Error GoTo 0 'Ressort de l'erreur qui permet de nouvelles erreurs
chemin = CheminSource
'Sauvegarde d'une copie du fichier avec la date
ActiveWorkbook.SaveCopyAs chemin & Format(Now(), "YYYY.MM.DD hh-mm-ss ") & NomMajuscule & " " & ThisWorkbook.Name
End Sub
Private Sub Workbook_Open()
Sheets("PV de chantier").Select
Application.DisplayFullScreen = True ' Affichage plein écran
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Code déplacer dans ThisWorkbook pour ne pas copier le code dans la feuille planning
Dim Numero_du_CFC As Variant
Dim Ligne_Insertion As Variant
Dim Cell_nouvelle_ligne As Variant
Dim Adresse_colonne_A As Variant
Application.ScreenUpdating = False ' Désactive le changement des pages à l'écran lors de l'éxécution de la macro
If ActiveSheet.Name = ("PV de chantier") Then
On Error GoTo Fin
'Colonne B
If Not Intersect([B50:B10000], Target) Is Nothing And Target.Count = 1 Then
Adresse_colonne_A = ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Address
' Masquer la ligne dans le planning
If Range(Adresse_colonne_A).Value Like "*20002" Then
If MsgBox("Afficher cette ligne dans le planning ?", vbYesNo + vbQuestion, "Contact") = vbYes Then
ActiveCell.Value = "P"
With Selection.Font
.Color = -16744448 'Couleur de police verte pour le vu
End With
ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Select
Else
ActiveCell.Value = ""
ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Select
End If
End If
End If
If Not Intersect([Celle_date_debut_planning], Target) Is Nothing And Target.Count = 1 Then
MsgBox "La modification de cette date déplacera toutes les dates du planning.", vbExclamation, "! IMPORTANT !"
End If
If Not Intersect([D50:D10000], Target) Is Nothing And Target.Count = 1 Then
If ActiveCell.Value = "CFC" Then
Inserer_lignes_CFC.Inserer_ligne_pour_nouveau_CFC
End If
End If
'Colonne C
If Not Intersect([C50:C10000], Target) Is Nothing And Target.Count = 1 Then
If ActiveCell <> "" Then
USF_Filtre_CFC.Show
End If
End If
'Colonne D
If Not Intersect([D50:D10000], Target) Is Nothing And Target.Count = 1 Then
Adresse_colonne_A = ActiveCell.Offset(rowOffset:=0, columnOffset:=-3).Address
Numero_du_CFC = ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Value
'Insérer une ligne pour un nouveau contact en dessous de la sélection
If Range(Adresse_colonne_A).Value Like "*10002" Then 'Si la cellule de la colonne A se termine par alors on ajoute une ligne de texte au PV du CFC
If MsgBox("Inserer une nouvelle ligne contact au " & Numero_du_CFC, vbYesNo + vbQuestion, "Editer le PV") = vbYes Then
Inserer_ligne_Contacts.InsererLigneContacts
End If
End If
'Insérer une ligne de texte au PV en dessous de la sélection
If Range(Adresse_colonne_A).Value Like "*20002" Then 'Si la cellule de la colonne A se termine par 200 alors on ajoute une ligne de texte au PV du CFC
If MsgBox("Inserer une nouvelle ligne au " & Numero_du_CFC, vbYesNo + vbQuestion, "Editer le PV") = vbYes Then
Inserer_ligne_texte_PV.InsererLigneTextePV
End If
End If
End If
'Colonne E
If Not Intersect([E50:E10000], Target) Is Nothing And Target.Count = 1 Then
Adresse_colonne_A = ActiveCell.Offset(rowOffset:=0, columnOffset:=-4).Address
'Insérer un nouveau CFC si la cellule est vide
If ActiveCell.Value = "" Then
If ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Value = "CFC" Then
Inserer_lignes_CFC.Inserer_nouveau_Numero_CFC
End If
End If
'Editer entreprise du CFC
If Range(Adresse_colonne_A).Value Like "*10001" Then 'Si la cellule de la colonne du CFC se termine par alors
If MsgBox("Modifier l'entreprise du CFC ?", vbYesNo + vbQuestion, "Editer le PV") = vbYes Then
If ActiveCell.Offset(rowOffset:=0, columnOffset:=11) = "" Then
Search_Entreprises.Show
Else
USF_Modifier_Entreprise_CFC.Show
End If
End If
End If
'Editer le contact
If Range(Adresse_colonne_A).Value Like "*10002" Then 'Si la cellule de la colonne du CFC se termine par alors
If ActiveCell = "" Then
If MsgBox("Ajouter une personne de contact ?", vbYesNo + vbQuestion, "Editer le PV") = vbYes Then
Search_Contact.Show
USF_Modifier_texte_contact.Show
End If
Else
USF_Modifier_texte_contact.Show
End If
End If
'Editer le texte du PV
If Range(Adresse_colonne_A).Value Like "*20002" Then 'Si la cellule de la colonne du CFC se termine par alors
USF_Modifier_texte_PV.Show
End If
End If
'Plage de F à J
Colonne_A = 1
Colonne_E = 5
Colonne_V = 22
If Not Intersect([F50:J10000], Target) Is Nothing And Target.Count = 1 Then
LigneCelluleActive = ActiveCell.Row
Adresse_colonne_A = Cells(LigneCelluleActive, Colonne_A).Address
'Editer le contact en cliquant sur la colonne F
If Range(Adresse_colonne_A).Value Like "*10002" Then
Cells(LigneCelluleActive, Colonne_E).Select
End If
'Editer le texte en cliquant sur la colonne F
If Range(Adresse_colonne_A).Value Like "*20002" Then
Cells(LigneCelluleActive, Colonne_E).Select
End If
End If
'Plage de U à V
If Not Intersect([U50:V10000], Target) Is Nothing And Target.Count = 1 Then
LigneCelluleActive = ActiveCell.Row
Adresse_colonne_A = Cells(LigneCelluleActive, Colonne_A).Address
'Liste de distribution du planning
If Range(Adresse_colonne_A).Value Like "*10002" Then
If Cells(LigneCelluleActive, Colonne_E).Value = "" Then 'Si pas de contact
Cells(LigneCelluleActive, Colonne_E).Select 'Sélectionner la cellule du contact
Exit Sub
Else
Cells(LigneCelluleActive, Colonne_V).Select
USF_Distribution_planning.Show
End If
End If
End If
'Plage de AS à BD pour ptotéger les formules
Colonne_BE = 57
If Not Intersect([AS49:BD10000], Target) Is Nothing And Target.Count = 1 Then
LigneCelluleActive = ActiveCell.Row
'Protection des formules
If Sheets("DATA Divers").Range("Cell_Protection_Formule").Value <> "Formules déprotégées" Then
Adresse_colonne_A = Cells(LigneCelluleActive, Colonne_A).Address
Cells(LigneCelluleActive, Colonne_BE).Select
MsgBox "La cellule sélectionnée est protégée"
End If
End If
'Plage entête du planning
If Not Intersect([Planning_Date_Entete], Target) Is Nothing And Target.Count = 1 Then
USF_Entete_Planning.Show
End If
End If
Fin:
End Sub |
