Discussion :

[hylis]

Bonjour à tous,

Dans le cadre de la réalisation d'un projet professionel, je réalise un planning commun, voir ci-dessous :



Je souhaiterai à présent, que lorqu'on clique (droit) sur une cellule, une message box s'affiche en fonction des données de l'évènement.

Je débute en VBA, et le code que j'ai essayé de réaliser bloque.

Est-ce que quelqu'un pourrait améliorer mon code, s'il vous plait ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("D6")) Is Nothing Then
 
Dim rech As String
 
 
rech = Application.WorksheetFunction.VLookup(Range("D6"), Sheets("Evènements").Range("C12:I25"), 3 , False)
 
 
MsgBox rech
'
' even Macro
'
' Touche de raccourci du clavier: Ctrl+y
'
 
End If
End Sub

Dans la msgbox finale, elle sera constitué de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MsgBox "Catégorie : " rech1 & vbCrLf & "Action : " & rech2

etc..

avec à chaque fois une recherche par colone :

1. rech1 : colonne 3
   rech2 : colonne 4
   rech3 : colonne 5
   etc...

Merci d'avance pour vos réponses,

bonne journée

[hylis]

De plus, j'aimerai que la formule s'applique dans le calendrier aux cellules : C6 à BL25

J'ai trouvé un code qui marche pour la première :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("D6")) Is Nothing Then
 
Dim rech1 As String
Dim rech2 As String
Dim rech3 As String
Dim rech4 As String
Dim rech5 As String
 
rech1 = Application.WorksheetFunction.VLookup(Range("D6"), Sheets("Evènements").Range("C12:I25"), 3, False)
rech2 = Application.WorksheetFunction.VLookup(Range("D6"), Sheets("Evènements").Range("C12:I25"), 4, False)
rech3 = Application.WorksheetFunction.VLookup(Range("D6"), Sheets("Evènements").Range("C12:I25"), 5, False)
rech4 = Application.WorksheetFunction.VLookup(Range("D6"), Sheets("Evènements").Range("C12:I25"), 6, False)
rech5 = Application.WorksheetFunction.VLookup(Range("D6"), Sheets("Evènements").Range("C12:I25"), 7, False)
 
MsgBox "Catégorie : " & rech1 & vbCrLf & "Action : " & rech2 & vbCrLf & "Commentaire : " & rech3 & vbCrLf & "Service : " & rech4 & vbCrLf & "Société(s) : " & rech5
'
 
End If
End Sub

Mais je n'arrive pas à la copier pour la cellule D7 par exemple et ainsi de suite

Merci d'avance pour vos réponses

[hylis]

J'ai un peu modifier mon code et j'aimerai qu'il fonctionne sur toute la plage "C6:BL25", mais je ne sais pas comment faire ...

Quelqu'un pourrait m'aider ?

Voici le nouveau code ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean)
If Sheets("Calendrier à 2 mois").Range("C6") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C6")
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C6")) Is Nothing Then
 
Dim rech1 As String
Dim rech2 As String
Dim rech3 As String
Dim rech4 As String
Dim rech5 As String
 
rech1 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("C12:I25"), 3, False)
rech2 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("C12:I25"), 4, False)
rech3 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("C12:I25"), 5, False)
rech4 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("C12:I25"), 6, False)
rech5 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("C12:I25"), 7, False)
 
MsgBox "Catégorie : " & rech1 & vbCrLf & "Action : " & rech2 & vbCrLf & "Commentaire : " & rech3 & vbCrLf & "Service : " & rech4 & vbCrLf & "Société(s) : " & rech5
 
 
End If
 
Else
MsgBox "Aucun évènement est enregistré à cette date"
 
End If
End Sub

Merci d'avance

[Nico Chg]

Bonjour,

(très belle présentation)

Je n'ai pas tout à fait compris la recherche que tu veux effectuer, et en fonction de quelle critère ?
Ce que j'ai compris : Tu as un planning, et quand tu clic sur une cellule (clic droit), tu cherche à obtenir des informations sur ... ?

C'est à dire que je ne comprend pas les vlookup que tu fait.

[hylis]

Nico Chg,

Voici le tableau de l'onglet "Evènements" :


Je voudrais pouvoir afficher les informations du tableau dans une msgbox, pour une cellule j'y arrive mais dès que je commence à vouloir le faire pour toute la plage, cela pose problème.
sur la feuille "Calendrier à 2 mois" je voudrais que l'on puisse cliquer sur les cellules : C6:BL25

[Nico Chg]

Bonjour,

Si j'ai bien compris ce que tu veux faire :

En fonction des dates présente dans le tableau (#5), tu veux clic droit sur ton calendrier (#1), pour qu'il t'afficher les bonnes informations ?

Pour que la plage prise en compte soit D6:BL25, rajoute en dessous de ton sub :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
If target.row <6 then exit sub
if target.row > 25 then exit sub
if target.column < 4 then exit sub
if target.column > 64 then exit sub

[hylis]

Avec ce nouveau code, à chaque fois que je clique sur une cellule, la message box m'affiche "Aucun évènement est enregistré à cette date" ; or il existe bien des évènements.

[Nico Chg]

re-bonjour,

Dans ce cas, enlève ce que j'ai rajouter, et change ta ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C6"))

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C6:BL25"))

[hylis]

J'ai déjà essayé mais le problème se pose lorsque que j'écris les recherches à effectuer tel que rech1, rech2 ...
car il prend comme valeur à rechercher "C6"

[Nico Chg]

Tu peux essayer de remplacer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rech1 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("C12:I25"), 3, False)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

rech1 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("C12:I25"), 3, False)

(et pour les autres recherches aussi)

Tout en gardant la plage C6:BL25 ?

[hylis]

Cela ne marche pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean)

If Sheets("Calendrier à 2 mois").target <> "" Then
Resultat = Sheets("Calendrier à 2 mois").target
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C6:BL25")) Is Nothing Then


Dim rech1 As String
Dim rech2 As String
Dim rech3 As String
Dim rech4 As String
Dim rech5 As String

rech1 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("C12:I25"), 3, False)
rech2 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("C12:I25"), 4, False)
rech3 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("C12:I25"), 5, False)
rech4 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("C12:I25"), 6, False)
rech5 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("C12:I25"), 7, False)MsgBox "Catégorie : " & rech1 & vbCrLf & "Action : " & rech2 & vbCrLf & "Commentaire : " & rech3 & vbCrLf & "Service : " & rech4 & vbCrLf & "Société(s) : " & rech5

End If

Else
MsgBox "Aucun évènement est enregistré à cette date"

End If

End Sub

[Nico Chg]

Oui très bien, mais il me faudrait un peu plus d'explication !

ça veut dire quoi ? Le code marche, mais ne fais pas ce que tu veux ? Tu as des erreurs d'exécution ?

[hylis]

En fait, je cherche le moyen que pour chaque cellule où l'on clique droit, une msgbox s'ouvre avec les informations de l'évènement dans l'onglet "évènements".
s'il n'y a aucun évènement défini dans la cellule (on peut le voir par la couleur de la cellule) alors avec un clic droit sur cette cellule, un msgbox s'ouvre avec "aucun évènement est enregistré à cette date"

J'insère le fichier dans la conversation en espérant qu'il pourra vous aider à mieux comprendre ma demande.

Merci d'avance

prjet.xlsm

[Nico Chg]

Je regarde ton fichier parceque je ne comprend pas du tout ce que tu veux faire

Cependant, ça veut dire quoi "ça ne marche pas ?" je n'ai toujours pas compris ce qui ne marchait pas

EDIT : D'après ce que je comprend (péniblement, vu le peu d'information disponible), tu recherche une abréviation dans ton calendrier, abréviation qui sont listé dans le tableaux "événements". Si tu trouve la bonne abréviation, tu affiche un msgbox avec les informations relatives à cette abréviation ?

Ce que je ne comprend pas, c'est comment tu obtiens des informations dans ton calendrier ?

On pars la dessus, ou je me suis planté ?

[hylis]

J'ai essayé de taper ce code en remplaçant les Range() par target, mais le programme ne fonctionnait plus.

J'ai réussi à trouver le code pour la première colonne, voir dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean)
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("c6")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C6") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C6")
Dim rech1 As String
Dim rech2 As String
Dim rech3 As String
Dim rech4 As String
Dim rech5 As String
rech1 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech2 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech3 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech4 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech5 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C6"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech1 & vbCrLf & "Action : " & rech2 & vbCrLf & "Commentaire : " & rech3 & vbCrLf & "Service : " & rech4 & vbCrLf & "Société(s) : " & rech5
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C7")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C7") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C7")
Dim rech6 As String
Dim rech7 As String
Dim rech8 As String
Dim rech9 As String
Dim rech10 As String
rech6 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C7"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech7 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C7"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech8 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C7"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech9 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C7"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech10 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C7"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech6 & vbCrLf & "Action : " & rech7 & vbCrLf & "Commentaire : " & rech8 & vbCrLf & "Service : " & rech9 & vbCrLf & "Société(s) : " & rech10
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C8")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C8") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C8")
Dim rech11 As String
Dim rech12 As String
Dim rech13 As String
Dim rech14 As String
Dim rech15 As String
rech11 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C8"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech12 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C8"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech13 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C8"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech14 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C8"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech15 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C8"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech11 & vbCrLf & "Action : " & rech12 & vbCrLf & "Commentaire : " & rech13 & vbCrLf & "Service : " & rech14 & vbCrLf & "Société(s) : " & rech15
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C9")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C9") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C9")
Dim rech16 As String
Dim rech17 As String
Dim rech18 As String
Dim rech19 As String
Dim rech20 As String
rech16 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C9"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech17 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C9"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech18 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C9"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech19 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C9"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech20 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C9"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech16 & vbCrLf & "Action : " & rech17 & vbCrLf & "Commentaire : " & rech18 & vbCrLf & "Service : " & rech19 & vbCrLf & "Société(s) : " & rech20
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C10")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C10") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C10")
Dim rech21 As String
Dim rech22 As String
Dim rech23 As String
Dim rech24 As String
Dim rech25 As String
rech21 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C10"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech22 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C10"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech23 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C10"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech24 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C10"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech25 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C10"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech21 & vbCrLf & "Action : " & rech22 & vbCrLf & "Commentaire : " & rech23 & vbCrLf & "Service : " & rech24 & vbCrLf & "Société(s) : " & rech25
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C11")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C11") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C11")
Dim rech26 As String
Dim rech27 As String
Dim rech28 As String
Dim rech29 As String
Dim rech30 As String
rech26 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C11"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech27 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C11"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech28 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C11"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech29 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C11"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech30 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C11"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech26 & vbCrLf & "Action : " & rech27 & vbCrLf & "Commentaire : " & rech28 & vbCrLf & "Service : " & rech29 & vbCrLf & "Société(s) : " & rech30
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C12")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C12") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C12")
Dim rech31 As String
Dim rech32 As String
Dim rech33 As String
Dim rech34 As String
Dim rech35 As String
rech31 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C12"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech32 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C12"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech33 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C12"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech34 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C12"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech35 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C12"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech31 & vbCrLf & "Action : " & rech32 & vbCrLf & "Commentaire : " & rech33 & vbCrLf & "Service : " & rech34 & vbCrLf & "Société(s) : " & rech35
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C13")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C13") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C13")
Dim rech36 As String
Dim rech37 As String
Dim rech38 As String
Dim rech39 As String
Dim rech40 As String
rech36 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C13"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech37 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C13"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech38 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C13"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech39 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C13"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech40 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C13"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech36 & vbCrLf & "Action : " & rech37 & vbCrLf & "Commentaire : " & rech38 & vbCrLf & "Service : " & rech39 & vbCrLf & "Société(s) : " & rech40
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C14")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C14") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C14")
Dim rech41 As String
Dim rech42 As String
Dim rech43 As String
Dim rech44 As String
Dim rech45 As String
rech41 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C14"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech42 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C14"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech43 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C14"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech44 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C14"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech45 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C14"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech41 & vbCrLf & "Action : " & rech42 & vbCrLf & "Commentaire : " & rech43 & vbCrLf & "Service : " & rech44 & vbCrLf & "Société(s) : " & rech45
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C15")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C15") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C15")
Dim rech46 As String
Dim rech47 As String
Dim rech48 As String
Dim rech49 As String
Dim rech50 As String
rech46 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C15"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech47 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C15"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech48 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C15"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech49 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C15"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech50 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C15"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech46 & vbCrLf & "Action : " & rech47 & vbCrLf & "Commentaire : " & rech48 & vbCrLf & "Service : " & rech49 & vbCrLf & "Société(s) : " & rech50
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C16")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C16") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C16")
Dim rech51 As String
Dim rech52 As String
Dim rech53 As String
Dim rech54 As String
Dim rech55 As String
rech51 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C16"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech52 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C16"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech53 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C16"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech54 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C16"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech55 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C16"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech51 & vbCrLf & "Action : " & rech52 & vbCrLf & "Commentaire : " & rech53 & vbCrLf & "Service : " & rech54 & vbCrLf & "Société(s) : " & rech55
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C17")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C17") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C17")
Dim rech56 As String
Dim rech57 As String
Dim rech58 As String
Dim rech59 As String
Dim rech60 As String
rech56 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C17"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech57 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C17"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech58 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C17"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech59 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C17"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech60 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C17"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech56 & vbCrLf & "Action : " & rech57 & vbCrLf & "Commentaire : " & rech58 & vbCrLf & "Service : " & rech59 & vbCrLf & "Société(s) : " & rech60
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C18")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C18") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C18")
Dim rech61 As String
Dim rech62 As String
Dim rech63 As String
Dim rech64 As String
Dim rech65 As String
rech61 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C18"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech62 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C18"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech63 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C18"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech64 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C18"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech65 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C18"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech61 & vbCrLf & "Action : " & rech62 & vbCrLf & "Commentaire : " & rech63 & vbCrLf & "Service : " & rech64 & vbCrLf & "Société(s) : " & rech65
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C19")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C19") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C19")
Dim rech66 As String
Dim rech67 As String
Dim rech68 As String
Dim rech69 As String
Dim rech70 As String
rech66 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C19"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech67 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C19"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech68 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C19"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech69 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C19"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech70 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C19"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech66 & vbCrLf & "Action : " & rech67 & vbCrLf & "Commentaire : " & rech68 & vbCrLf & "Service : " & rech69 & vbCrLf & "Société(s) : " & rech70
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C20")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C20") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C20")
Dim rech71 As String
Dim rech72 As String
Dim rech73 As String
Dim rech74 As String
Dim rech75 As String
rech71 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C20"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech72 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C20"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech73 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C20"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech74 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C20"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech75 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C20"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech71 & vbCrLf & "Action : " & rech72 & vbCrLf & "Commentaire : " & rech73 & vbCrLf & "Service : " & rech74 & vbCrLf & "Société(s) : " & rech75
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C21")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C21") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C21")
Dim rech76 As String
Dim rech77 As String
Dim rech78 As String
Dim rech79 As String
Dim rech80 As String
rech76 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C21"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech77 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C21"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech78 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C21"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech79 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C21"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech80 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C21"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech76 & vbCrLf & "Action : " & rech77 & vbCrLf & "Commentaire : " & rech78 & vbCrLf & "Service : " & rech79 & vbCrLf & "Société(s) : " & rech80
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C22")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C22") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C22")
Dim rech81 As String
Dim rech82 As String
Dim rech83 As String
Dim rech84 As String
Dim rech85 As String
rech81 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C22"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech82 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C22"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech83 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C22"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech84 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C22"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech85 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C22"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech81 & vbCrLf & "Action : " & rech82 & vbCrLf & "Commentaire : " & rech83 & vbCrLf & "Service : " & rech84 & vbCrLf & "Société(s) : " & rech85
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C23")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C23") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C23")
Dim rech86 As String
Dim rech87 As String
Dim rech88 As String
Dim rech89 As String
Dim rech90 As String
rech86 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C23"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech87 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C23"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech88 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C23"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech89 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C23"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech90 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C23"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech86 & vbCrLf & "Action : " & rech87 & vbCrLf & "Commentaire : " & rech88 & vbCrLf & "Service : " & rech89 & vbCrLf & "Société(s) : " & rech90
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C24")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C24") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C24")
Dim rech91 As String
Dim rech92 As String
Dim rech93 As String
Dim rech94 As String
Dim rech95 As String
rech91 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C24"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech92 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C24"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech93 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C24"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech94 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C24"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech95 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C24"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech91 & vbCrLf & "Action : " & rech92 & vbCrLf & "Commentaire : " & rech93 & vbCrLf & "Service : " & rech94 & vbCrLf & "Société(s) : " & rech95
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("C25")) Is Nothing Then
If Sheets("Calendrier à 2 mois").Range("C25") <> "" Then
Resultat = Sheets("Calendrier à 2 mois").Range("C25")
Dim rech96 As String
Dim rech97 As String
Dim rech98 As String
Dim rech99 As String
Dim rech100 As String
rech96 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C25"), Sheets("Evènements").Range("B12:I25"), 3, False)
rech97 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C25"), Sheets("Evènements").Range("B12:I25"), 4, False)
rech98 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C25"), Sheets("Evènements").Range("B12:I25"), 5, False)
rech99 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C25"), Sheets("Evènements").Range("B12:I25"), 6, False)
rech100 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").Range("C25"), Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech96 & vbCrLf & "Action : " & rech97 & vbCrLf & "Commentaire : " & rech98 & vbCrLf & "Service : " & rech99 & vbCrLf & "Société(s) : " & rech100
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If

Cependant j'ai éssayé de le reproduire pour toute les colonnes jusqu'à BL, mais à partir de la colonne I, le programme bloque car il comprend trop d'information.

Quelqu'un pourrait il me le simplifier s'il vous plait ?


Merci d'avance

[hylis]

Nico Chg,

J'ai essayé de suivre tes instructions et donc décrire ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean)
 
If target.Row < 6 Then Exit Sub
If target.Row > 25 Then Exit Sub
If target.Column < 4 Then Exit Sub
If target.Column > 64 Then Exit Sub
 
If Not Intersect(target, Sheets("Calendrier à 2 mois").Range("c6:BL25")) Is Nothing Then
If Sheets("Calendrier à 2 mois").target <> "" Then
Resultat = Sheets("Calendrier à 2 mois").target
Dim rech1 As String
Dim rech2 As String
Dim rech3 As String
Dim rech4 As String
Dim rech5 As String
rech1 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("B12:I25"), 3, False)
rech2 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("B12:I25"), 4, False)
rech3 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("B12:I25"), 5, False)
rech4 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("B12:I25"), 6, False)
rech5 = Application.WorksheetFunction.VLookup(Sheets("Calendrier à 2 mois").target, Sheets("Evènements").Range("B12:I25"), 7, False)
MsgBox "Catégorie : " & rech1 & vbCrLf & "Action : " & rech2 & vbCrLf & "Commentaire : " & rech3 & vbCrLf & "Service : " & rech4 & vbCrLf & "Société(s) : " & rech5
Else
MsgBox "Aucun évènement est enregistré à cette date"
End If
End If
 
 
End Sub

Cependant il ne fonctionne pas

[Nico Chg]

Bonjour !

Et bien je suis tout disposé à t'aider ! Cependant, si tu ne réponds pas à mes questions, on va pas aller loin ! Je n'aime pas trop donner des codes fonctionnels en entier, je préfère travailler avec toi, et te donner des pistes

La question était : "ça ne fonctionne pas, oui mais qu'est ce qui ne fonctionne pas ? Une erreur d’exécution ? Le programme ne fait pas ce que tu veux qu'il fasse ?"

Ensuite, j'essaie de comprendre comment tu construis ta msgbox, tu fais des vlookup pour chercher des infos, mais quelle valeur recherche tu ? Comment cette valeur est générée ? Préfère tu le café ou le thé ?

[hylis]

Pour répondre à ta première question voici une impression d'écran, qui je l'espère, peux t'aider.


Ensuite je souhaite que ma msgbox affiche les informations relatives aux évènements, je m'explique :
dans mon calendrier, des évènements s'affiche en fonction de la date.
Si un évènement est au 02/03/2015 alors il affichera son code, puis avec une mise en forme conditionnelle, ce code se traduira par une couleur selon le type d'évènement (obligation, projet...)
Cependant ces couleurs montrent la charge de travail mais ne montre pas le nom de l'évènement, par exemple.
Du coup, je désire que lorsque l'on clique droit sur une cellule, la message box s'affiche avec le nom de l'évènement.

Les VlookUp recherche les informations selon le tableau ci-dessous :



J'espère avoir été plus clair cette fois ci.

[Nico Chg]

Déjà un peu plus, dire "une erreur d’exécution" m'aurait déjà mis sur la piste. Reste à savoir quelle est l'erreur en question ?
Je comprends déjà beaucoup mieux, je vais jeter un coup d’œil au fichier exemple, je reviens vers toi par la suite.

[Nico Chg]

Après avoir regarder ton problème un peu mieux, je te propose un truc comme ça :

J'ai enlever les vlookup, je fait juste un "find" la valeur de ta target (la ou tu as cliquer) dans la feuille événement, je récupère la ligne associer, et via la ligne je récupère les info de la colonne 3/4/5/6/7.

J'ai mis une valeur arbitraire de 200, parceque si ma recherche ne renvoie rien, et bien RowEvent vaut 1000000 et quelques (valeur max Excel). J'ose espérer que tu n'as pas 1 000 000 de critères, mais si tu as plus de 200 critère, il faut remonter cette valeur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
Dim WsEvent As Worksheet
Dim RowEvent As Single
Dim rech1 As String
Dim rech2 As String
Dim rech3 As String
Dim rech4 As String
Dim rech5 As String
 
If Target.Row < 6 Then Exit Sub
If Target.Row > 25 Then Exit Sub
If Target.Column < 4 Then Exit Sub
If Target.Column > 64 Then Exit Sub
 
Set WsEvent = Sheets("Evènements")
 
With WsEvent
    'Fais une recherche dans la colonne 3 de la feuille Evenement de la valeur de la cellule sur laquelle tu as RightClic
    RowEvent = .Columns(3).Find(Target.Value, , , , xlByColumns, xlPrevious).Row
 
    'Si RowEvent renvoie un truc cohérent (une ligne entre 2 et 199), je récupère la valeur des colonne 3/4/5/6/7 dans les variables rech1/2/3/4/5
    If RowEvent > 1 And RowEvent < 200 Then
        rech1 = .Cells(RowEvent, 3).Value
        rech2 = .Cells(RowEvent, 4).Value
        rech3 = .Cells(RowEvent, 5).Value
        rech4 = .Cells(RowEvent, 6).Value
        rech5 = .Cells(RowEvent, 7).Value
 
        'Affiche le msgbox
        MsgBox "Catégorie : " & rech1 & vbCrLf & "Action : " & rech2 & vbCrLf _
        & "Commentaire : " & rech3 & vbCrLf & "Service : " & rech4 & vbCrLf & "Société(s) : " & rech5
 
    Else
        MsgBox "Aucun évènement est enregistré à cette date"
    End If
End With
 
End Sub

Tester chez moi, ça marche. Je te renvoie ton fichier avec le code modifié : prjet (1).xlsm