1 pièce(s) jointe(s)
VBA - Récupération cellule et surlignage
Bonjour le forum,
Je viens vers vous parce que j'ai un soucis de macro.
Dans la feuille Planning! de mon fichier il y'a des jalons inscrit en face des date (J0,J1, J2, J3 voir beaucoup plus). Je souhaite faire une comparaison entre ces dates:
Si le jalon J1 n'est pas passé alors la plage J0-J1 se surligne en rouge et si elle l'est elle se surligne en vert.
Il faudrait faire ça pour tout les jalons.
PB: il y'a une série de jalons dans une seule colonne et il y'a plusieurs colonne qui seront renseignées.
Evidemment les jalons ne sont pas définitifs (ils varient suivant le projet).
N'ayant jamais fais de macro j'ai essayé de faire quelquechose (qui est faux ...):
Code:
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
|
Sub Surlignage()
Dim i As String
Dim Plage As Range
Dim Cellule As Range
Dim Posit As Long
Dim Jalon0 As Integer
Dim Jalon1 As Integer
Dim Jalon2 As Integer
Dim Jalon3 As Integer
Dim Jalon4 As Integer
Dim Jalon5 As Integer
Dim Jalon6 As Integer
On Error Resume Next
Set Plage = Sheets("Planning").Range(Cells(1, 2), Cells(426, 15))
For Set Plage = Sheets("Planning").Range(Cells(4, 2), Cells(426, 15)) 'Plage où se trouvent mes jalons
If Cellule.Value <> "J0" Then ' Récupération de la position des jalons
Jalon0 = "J0"
End If
If Cellule.Value <> "J1" Then
Jalon1 = "J1"
End If
If Cellule.Value <> "J2" Then
Jalon2 = "J2"
End If
If Cellule.Value <> "J3" Then
Jalon2 = "J3"
End If
If Cellule.Value <> "J4" Then
Jalon2 = "J4"
End If
If Cellule.Value <> "J5" Then
Jalon2 = "J5"
End If
If Cellule.Value <> "J6" Then
Jalon2 = "J6"
End If
For i = 1 To 5
If DateDiff("y",Date(Now()),Date(Range(Jaloni))<>0 Then ' Si la date d'aujourd'hui ne correspond pas
Target.Interior.Color.Index = 44 ' à la date du jalon 1: surligner couleur 44
End If
If DateDiff("y",Date(Now()),date(Jj))=0 Then 'Si la date d'ajourd'hui correspond à jalon1:
Target.Interior.Color.Index = 50 ' surligner couleur 50
End If
Next
Next
End Sub |
Avez-vous une^petite idée ?
Merci pour votre attention
Cdlt aure_8
