Mise en forme conditionnelle d'un calendrier en VBA
Bonjour à tous,
Voila le code VBA utilisé pour mettre en forme conditionnelle un calendrier :
Sub MFEC_Cal()
Dim i As Integer, X As Integer, s As Integer, nbj As Integer
Dim cl As Integer, ans As Integer, Cel As Range, jm, Position, mmm
Dim L As Variant, C As Variant, Y As Range
ans = Year(Now)
mmm = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
Position = Array("B3", "K3", "B10", "K10", "B17", "K17", "B24", "K24", "B31", "K31", "B38", "K38")
'année bissextile
If (ans Mod 4) = 0 And (ans Mod 100) > 0 Or (ans Mod 400) = 0 Then
jm = Array(0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
Else
jm = Array(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
End If
With Sheets("Feuil1").Range("A3:T56")
'.ClearContents
.Clear
.Font.ColorIndex = xlAutomatic
End With
Application.ScreenUpdating = False
For i = 1 To 12
With Sheets("Feuil2")
.Range("A2:H7").ClearContents
nbj = jm(i)
cl = Choose(Weekday(DateSerial(ans, i, 1)), 7, 1, 2, 3, 4, 5, 6)
.Range("A1") = mmm(i - 1)
For Each Cel In .Range("A2:G7")
If Not (Cel.Column < cl And X = 0) Then
If X >= nbj Then X = 0: Exit For
X = X + 1
.Range(Cel.Address) = X
If .Cells(Cel.Row, 8) = "" Then .Cells(Cel.Row, 8) = _
Application.WeekNum(DateSerial(ans, i, X), 2)
End If
Next Cel
Application.ScreenUpdating = True
.Range("A1:H7").Copy Sheets("Feuil1").Range(Position(i - 1))
Application.CutCopyMode = False
End With
Next
L = Array(0, 3, 3, 10, 10, 17, 17, 24, 24, 31, 31, 38, 38)
C = Array(0, 2, 11, 2, 11, 2, 11, 2, 11, 2, 11, 2, 11)
Cells.FormatConditions.Delete
'--- Aujourd'hui
Set plage = Cells(L(Month(Date)), C(Month(Date))).Offset(1).Resize(6, 7)
With plage
Debug.Print "Addresse aujourdhui : " & plage(1, 1).Address(0, 0)
[W1] = plage(1, 1).Address(0, 0)
[W2] = "=" & plage(1, 1).Address(0, 0) & "=JOUR(AUJOURDHUI())"
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=" & plage(1, 1).Address(0, 0) & _
"=JOUR(AUJOURDHUI())"
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
End With
End With
'-- Weekends
For i = 1 To 12
Set plage = Cells(L(i), C(i)).Offset(1).Resize(6, 7)
With plage
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ET(JOURSEM(DATE(ANNEE($B$1);" & i & ";" & plage(1, 1).Address(0, 0) & ");2)>5;" & _
plage(1, 1).Address(0, 0) & "<>"""")"
With .FormatConditions(.FormatConditions.Count).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
'-- Fériés
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ET(ESTNUM(EQUIV(DATE(ANNEE($B$1);" & Application.Match(plage(0, 1).Value, mmm, 0) & ";" & plage(1, 1).Address(0, 0) & ")*1;Fériés;0));" & _
plage(1, 1).Address(0, 0) & "<>"""")"
With .FormatConditions(.FormatConditions.Count).Interior
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
End With
End With
Next i
End SubMais le resulat voulu n'est pas réaliser !
Une autre remarque :
Les formules utilisée dans le code se transforme dans la MEFC en addresse bizzare :
Par exemple pour la formule du jour en cours :
La formule dans le code :
"=" & plage(1, 1).Address(0, 0) & _
"=JOUR(AUJOURDHUI())"La formule dans la MEFC :
=XEK11=JOUR(AUJOURDHUI())La plage.Address(0,0) est représentée par XEK11
Merco d'avance.
Pourquoi ne pas faire les MFC directement sans macros ?
Bonjour Steelson,
Parce que le calendrier est initialement créer par macro !
Oui je comprends, le résultat est du reste bien ordonné ... mais quand bien même la macro peut y mettre des jours et la MFC s'adapter.
Je vais m'y pencher ... sauf si un expert te trouve la solution !
je viens d'effacer toutes les MFC et je viens de refaire tourner la macro, j'ai bien une et une seule MFC en gris dont la formule est
=B11=JOUR(AUJOURDHUI())et applicable à tout le carré de mars ... donc pas de problème !
Pour les zones orangées qui sont les week end je suppose ... il y a comme un problème : dans tes formules (MFC) tu mets ANNEE($B$1) ... dans ce cas il faut mettre 1/1/2015 en $B$1 car dans ton exemple, en ne mettant que l'année, il interprète comme l'année 1905 puisque le nombre 2015 correspond au jour du 7/7/1905 !
Mais pourquoi, au lieu d'avoir une adresse de cellule, j'obtiens un code pour les formules :
=XEH6=JOUR(AUJOURDHUI())Que signifie ce code XEH6 ?
Est-ce pour cela que la MEFC ne fonctionne pas ?
Je te retourne le fichier après avoir :
- supprimé manuellement toutes les MFC
- lancé une fois la macro
- corrigé en B1 la date (1/1/2015)
je n'ai pas une telle formule, elle est propre
=B11=JOUR(AUJOURDHUI())Bonjour,
Je ne sais pour quelle raison je continu à obtenir des codes à la place d’adresses de cellule
Bonjour,
Ce ne sont pas des codes, c'est une référence de cellule.
Dans certaines conditions (bug ?) excel remplace la référence choisie par une référence située vers la dernière ligne (ou colonne).
Dans ce cas la solution est de corriger et de re-valider. Mais par macro tu vas être embêté pour faire ça.
Ceci dit tu n'es peut-être pas dans ce cas. La référence d'une MFC avec référence relative est tributaire de la cellule active.
Nulle part je ne la vois sélectionnée dans ta macro (mais il est tard...), ça peut donc être n'importe quelle cellule. Essaie en sélectionnant la cellule qui va bien en début de macro.
eric
Bonjour eric,
En ajoutant des select, la mise en forme conditionnelle à réussi.
Merci eric.
Bonjour,
ok, n'oublie pas de mettre en résolu.
eric
Bonjour,
eriiic a écrit :n'oublie pas de mettre en résolu.
Je me disais qu'il y a peut-être des remarques sur le code.
Mais bon, tout est rentré dans le normal.
Merci encore.