Passer en couleur le jour sans MFC
a
Bonjour le forum
J'ai réussi a faire fonctionner quand même mais y a t-il mieux à faire sans MFC?
J'ai mis
Colorise_Jour en commentaires et ça fonctionne
La ligne
Range("A" & J & ":G" & J).Interior.ColorIndex = 17est à mettre en interior color
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim Ladate As Date
Dim MoisSuivant As String
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
' On recherche si la page est surveillée
If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", _
Split(Sh.Name, " ")(0), vbTextCompare) Then
' Calcul du nombre de jour dans le mois indiqué par le nom de la feuille
NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)
If Target.Row - 5 > Day(Date) Then
Beep
MsgBox "PAS LE BON JOUR"
Target = ""
Else
' Surveille la plage du 1er au dernier jours du mois
If Not Intersect(Range("B6:C" & 5 + NombreJour), Target) Is Nothing Then
' Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée
Ladate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)
' Si la colonne B et la colonne C est vide on efface la date
Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Ladate)
If Range("A" & Target.Row) <> "" Then
If Application.CountIf(Sheets("Menu").Range("JOursFériés"), Range("A" & Target.Row)) > 0 Or _
Weekday(Range("A" & Target.Row), vbMonday) > 5 Then ' Férié ou WE
Range("A" & Target.Row & ":G" & Target.Row).Interior.ColorIndex = 38
Else
Range("A" & Target.Row).Interior.ColorIndex = 15
Range("B" & Target.Row).Interior.ColorIndex = 6
Range("C" & Target.Row).Interior.ColorIndex = 4
Range("D" & Target.Row).Interior.ColorIndex = 43
Range("E" & Target.Row).Interior.ColorIndex = 43
Range("F" & Target.Row).Interior.ColorIndex = 43
Range("G" & Target.Row).Interior.ColorIndex = 43
End If
Else
Range("A" & Target.Row & ":G" & Target.Row).Interior.ColorIndex = 8
End If
'Colorise_Jour 'Pour faire passer la couleur sur le jour d'aujourdhui mettre Colorise_Jour en commentaires
' si la ligne modifiée est la dernière du mois et que la colonne est la C
If Target.Row = NombreJour + 5 And Target.Column = 3 Then
' On construit le nom de la feuille du mois suivant
MoisSuivant = MonthName(Month(DateAdd("m", 1, DateValue(Sh.Name)))) & " " & Year(DateAdd("m", 1, DateValue(Sh.Name)))
' On va vérifier si la feuille existe
If FeuilleExiste(MoisSuivant) = False Then Exit Sub
' La feuille existe
With Sheets(MoisSuivant)
'On la rend visible
.Visible = xlSheetVisible
' On masque celle que l'on vient de finir
ActiveSheet.Visible = xlSheetHidden
' et on la sélectionne
.Select
End With
End If
End If
End If
End If
Application.EnableEvents = True
End SubOption Explicit
Sub Colorise_Jour()
Dim J As Long
For J = 6 To 36
If Range("B" & J) = "" And Range("C" & J) = "" Then
If J > 6 Then
Range("A" & J & ":G" & J).Interior.ColorIndex = 17
End If
Exit For
End If
Next J
End SubMFC dans les 12 mois de l'année
=$A6=AUJOURDHUI()a
Bonjour le forum
Voici le fichier purgé
Comme vous pouvez le constater la ligne couleur 17 est au dessous la ligne d'aujourdh'ui
Comment obtenir avec la macro la ligne interiorcolor 17 aujourdh'ui sans MFC?
Cordialement
a
Bonjour le forum
Peut-on supprimer un fichier?
Merci pour vos réponses
Bonjour al,
mais comme tu as posté moins de 500 messages, tu ne peux plus modifier ton précédent post :
la limite est de 60 mn après la date de création du post.
dhany
a
Bonjour dhany
Donc impossible. Je vais clôturer le sujet car ça ne "mord" pas!!!
Bonne journée à toi
a
Bonjour le forum
Voilà la réponse sur un autre forum
Sub Colorise_Jour()
Dim J As Long
For J = 6 To 36
If Range("A" & J) = Date Then
If J > 6 Then
Range("A" & J & ":G" & J).Interior.ColorIndex = 17
End If
Exit For
End If
Next J
End SubCordialement
merci pour avoir mis en partage la solution !
dhany
a
Bonjour dhany
C'est normal ça servira à d'autres internautes "malheureux" comme moi!!!
Bien cordialement
a
Bonjour le forum
Fausse alerte
Ce matin à l'ouverture du fichier...
Les 2 lignes du lundi et mardi en couleur alors qu'il ne devrait y avoir que la ligne du mardi (ligne 10)
P$$$$Nj on sortira pas
Cordialement
a
Bonjour le forum
Merci à un membre d'un autre forum
Bien cordialement à vous
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 'Macro sans COLORISE
Dim NombreJour As Integer
Dim Ladate As Date
Dim MoisSuivant As String
Dim Plage As Range
Dim Cel As Range
Dim F As String
Dim I As Integer
Dim J As Integer
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
' On recherche si la page est surveillée
If InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", Split(Sh.Name, " ")(0), vbTextCompare) Then
' Calcul du nombre de jour dans le mois indiqué par le nom de la feuille
NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)
If Target.Row - 5 > Day(Date) Then
Beep
MsgBox "PAS LE BON JOUR"
Target = ""
Range(Cells(Target.Row, 1), Cells(Target.Row, 7)).Interior.ColorIndex = 8
Else
' Surveille la plage du 1er au dernier jours du mois
If Not Intersect(Range("B6:C" & 5 + NombreJour), Target) Is Nothing Then
' Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée
Ladate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)
' Si la colonne B et la colonne C est vide on efface la date
Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Ladate)
' si la ligne modifiée est la dernière du mois et que la colonne est la C
If Target.Row = NombreJour + 5 And Target.Column = 3 Then
' On construit le nom de la feuille du mois suivant
MoisSuivant = MonthName(Month(DateAdd("m", 1, DateValue(Sh.Name)))) & " " & Year(DateAdd("m", 1, DateValue(Sh.Name)))
' On va vérifier si la feuille existe
If FeuilleExiste(MoisSuivant) = False Then Exit Sub
' La feuille existe
With Sheets(MoisSuivant)
'On la rend visible
.Visible = xlSheetVisible
' On masque celle que l'on vient de finir
ActiveSheet.Visible = xlSheetHidden
' et on la sélectionne
.Select
End With
End If
End If
If Range("A" & Target.Row) <> "" Then
Application.ScreenUpdating = False
Set Plage = Range(Cells(6, 1), Cells(6 + NombreJour, 1)).Resize(, 7)
'mémorise le formatage de la colonne A puis passe la colonne A au format "Standard" pour avoir des valeurs de type Long
F = Plage.Columns(1).NumberFormat
Plage.Columns(1).NumberFormat = "General"
'effectue la recherche de la date en type Long sur la colonne A
Set Cel = Plage.Columns(1).Find(CLng(Date), , xlValues, xlWhole)
'puis rétabli le format
Plage.Columns(1).NumberFormat = F
Plage.Interior.ColorIndex = 8
'si trouvée, mets la plage au fond 8 puis colore la ligne du jour
If Not Cel Is Nothing Then
Range(Cells(Cel.Row, 1), Cells(Cel.Row, Plage.Columns.Count)).Interior.ColorIndex = 17
J = Cel.Row - 1
End If
If J = 0 Then J = Plage.Rows.Count + 6
'colore ensuite les cellules en fonction du jour
For I = 6 To J
If Cells(I, 1).Value <> "" Then
If Application.CountIf(Sheets("Menu").Range("JOursFériés"), Range("A" & I)) > 0 Or Weekday(Range("A" & I), vbMonday) > 5 Then
Range("A" & I & ":G" & I).Interior.ColorIndex = 38
Else
Range("A" & I).Interior.ColorIndex = 15
Range("B" & I).Interior.ColorIndex = 6
Range("C" & I).Interior.ColorIndex = 4
Range("D" & I & ":G" & I).Interior.ColorIndex = 43
End If
End If
Next I
Application.ScreenUpdating = True
End If
End If
End If
Application.EnableEvents = True
End Sub