Bonjour,
j'utilise une feuille excel comme calendrier avec les dates en colonnes et des lieux en lignes pour indiquer des périodes de fermeture.
les colonnes sont grisées pour les samedis dimanches.
Les périodes de fermeture sont représentées par des zones de couleur différentes sur les lignes concernées.
Une possibilité de correction permet de rétablir l'aspect d'origine avec uniquement des cellules en couleur grise pour les samedi dimanche en effaçant la couleur et les contenus des cellules.
La corrections se fait avec le code ci-après qui fait appel à weekday() pouir identifier le jour de semaine correspondant à la date.
Ceci fonctionne si un seul week-end est concerné par la zone à corriger mais dès qu'il y a plus de 7 jours j'ai un décalage du fait de la numérotation des jours de 1 à 7 (soit 7 possibilités) alors qu'il en faut 8 pour aller du samedi au samedi suivant. Ce sera dont le vendredi qui sera en gris etc.
Je cherche depuis un moment pour contourner, sans succès.
Mon code est-il approprié ? quelqu'un a-t-il une autre solution ?
Merci d'avance si vous avez le temps de jeter un coup d’œil.
Option Explicit
Public rPeriode As Range
Sub SelectPeriode()
Dim iNbColonnes 'Nombre de colonnes de la selection
Dim rCellule As Range 'les cellules de la sélection
Dim iNoColonne As Integer 'numero de la colonne sur la feuille
Dim compteur As Integer 'compteur
Dim dDate As Date 'date pour laquelle il faut trouver le jour de semaine
Dim iJour As Integer 'numero du jour de semaine calculé avec weekday()
'Set rPeriode = selection
Set rPeriode = Application.InputBox(prompt:="Sélectionner la période souhaitée sur la feuille", Title:="Période
sélectionnée", Type:=8)
'MsgBox rPeriode.Address
iNbColonnes = rPeriode.Columns.Count
'MsgBox iNbColonnes
For compteur = 1 To iNbColonnes
iNoColonne = rPeriode(compteur).Column
'MsgBox NoColonne
dDate = Cells(1, iNoColonne).Value
rPeriode(compteur).Select
iJour = Weekday(dDate, vbMonday)
'MsgBox iJour
If ((iJour = 6) Or (iJour = 7)) Then
rPeriode(compteur).Select
With selection.Interior
.ColorIndex = 16 'ou 15
End With
End If
Next
rPeriode.Select
End Sub
j'utilise une feuille excel comme calendrier avec les dates en colonnes et des lieux en lignes pour indiquer des périodes de fermeture.
les colonnes sont grisées pour les samedis dimanches.
Les périodes de fermeture sont représentées par des zones de couleur différentes sur les lignes concernées.
Une possibilité de correction permet de rétablir l'aspect d'origine avec uniquement des cellules en couleur grise pour les samedi dimanche en effaçant la couleur et les contenus des cellules.
La corrections se fait avec le code ci-après qui fait appel à weekday() pouir identifier le jour de semaine correspondant à la date.
Ceci fonctionne si un seul week-end est concerné par la zone à corriger mais dès qu'il y a plus de 7 jours j'ai un décalage du fait de la numérotation des jours de 1 à 7 (soit 7 possibilités) alors qu'il en faut 8 pour aller du samedi au samedi suivant. Ce sera dont le vendredi qui sera en gris etc.
Je cherche depuis un moment pour contourner, sans succès.
Mon code est-il approprié ? quelqu'un a-t-il une autre solution ?
Merci d'avance si vous avez le temps de jeter un coup d’œil.
Option Explicit
Public rPeriode As Range
Sub SelectPeriode()
Dim iNbColonnes 'Nombre de colonnes de la selection
Dim rCellule As Range 'les cellules de la sélection
Dim iNoColonne As Integer 'numero de la colonne sur la feuille
Dim compteur As Integer 'compteur
Dim dDate As Date 'date pour laquelle il faut trouver le jour de semaine
Dim iJour As Integer 'numero du jour de semaine calculé avec weekday()
'Set rPeriode = selection
Set rPeriode = Application.InputBox(prompt:="Sélectionner la période souhaitée sur la feuille", Title:="Période
sélectionnée", Type:=8)
'MsgBox rPeriode.Address
iNbColonnes = rPeriode.Columns.Count
'MsgBox iNbColonnes
For compteur = 1 To iNbColonnes
iNoColonne = rPeriode(compteur).Column
'MsgBox NoColonne
dDate = Cells(1, iNoColonne).Value
rPeriode(compteur).Select
iJour = Weekday(dDate, vbMonday)
'MsgBox iJour
If ((iJour = 6) Or (iJour = 7)) Then
rPeriode(compteur).Select
With selection.Interior
.ColorIndex = 16 'ou 15
End With
End If
Next
rPeriode.Select
End Sub
