Microsoft 365 Date du jour avec weekend

[ShuarS]

Bonjour à tous,

J’essaie d’écrire un bout de code pour les fonctions suivantes :

1. Sur cellule D1 = Date du jour au format Date (25/11/2019 par exemple) ;
2. Étendre les dates jusqu’au 31/01/2021 sur la même ligne ;
3. Colorier en gris toutes les colonnes correspondantes aux samedis et dimanches (de la ligne 1 à la 200)

Pour vous donner une idée, je joins une feuille d'exemple.

Merci pour votre aide
Shu

 

[xUpsilon]

Bonjour,

Tu as déjà trouvé pour la MFC visiblement.
Sinon pour avoir la date du jour et incrémenter : =AUJOURDHUI() te renvoie la date du jour, puis ensuite dans les cellules qui suivent tu mets E1 = D1 + 1, et tu étires jusqu'au bout

Bonne continuation

 

[ShuarS]

Merci,

Oui MFC ok, le AUJOURDHUI() ok, le +1 ok, mais comment effectuer l'analyse des samedis et des dimanches ?
Car la formule =JOURSEM(D$1;2)>5 ne traite pas directement ces jours là mais juste un saut.

Shu

 

[xUpsilon]

Re,

Je ne vois pas ce que tu veux dire par là. JOURSEM renvoie toujours 1 pour Lundi, 2 pour Mardi, etc ... Quelle que soit la semaine en question, le premier jour de la série de données ou autres. Donc tester si >5 ça revient à cibler directement les samedis et dimanches.

Bonne continuation

 

[ShuarS]

Heu oui tu as raison. Je ne sais pas trop ce que je faisais, mais c'est ok maintenant.
Merci pour le soutien psychologique

 

[ShuarS]

Question supplémentaire pour la MFC dans VBA svp.

Comment remplacer "Range("D1:Q200").Select" par la quantité de cellule non vide de la colonne A ?

        Range("D1:Q200").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=JOURSEM(D$1;2)>5"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

Plutôt que d'étendre la zone de la MFC sur 200 lignes, j'aimerais que le nombre de ligne soit variable suivant la quantité de cellule non vide de la colonne A.

Merci,
Shu

 

[ShuarS]

J'ai avancé là dessus mais le code ne fonctionne pas correctement

With Intersect(.Range("A2:A" & .Rows.Count).SpecialCells(xlCellTypeConstants).EntireRow, .[D:Q])
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=JOURSEM(D$1;2)>5"
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.499984740745262
      
End With

Help

 

[ShuarS]

Je ne m'en sors pas.
La formule est bien écrite dans la zone voulue, mais la mise en forme n'est pas appliquée

With Intersect(.Range("A2:A" & .Rows.Count).SpecialCells(xlCellTypeConstants).EntireRow, .[D:Q])
    
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=JOURSEM(D$1;2)>5"
        .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .Pattern = xlLightUp
            .PatternColor = 255
            .ColorIndex = xlAutomatic
            .PatternTintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
        
End With

Re help

 

[Eric C]

Bonsoir le forum
Bonsoir ShuarS, xUpsilon

Trouvé dans mes archives et modifié pour ta demande :

Sub Calendrier()
Dim deb#, fin#, NbJours&, i#
Dim Cell As Range, Li&, Col%
 
  On Error Resume Next
  deb = CDate(InputBox("Première date du calendrier :"))
  fin = CDate(InputBox("Dernière date du calendrier :"))
    
  If Err <> 0 Then Exit Sub
 
  Set Cell = Application.InputBox _
    ("Sélectionnez la cellule où commence le calendrier", Type:=8)

  If Err <> 0 Then Exit Sub
 
   Li = Cell.Row: Col = Cell.Column
 
  For i = deb To fin
    Cells(Li, Col).Value2 = i
    If Weekday(i, vbMonday) > 5 Then _
        Cells(Li, Col).Interior.ColorIndex = 6
    Cells(Li, Col).NumberFormatLocal = "jj/mm/aaaa"
    Col = Col + 1 
  Next i
End Sub

Bonne soirée à toutes & à tous
@+Eric c

 

[ShuarS]

Merci @Eric C ,

Une idée pour la dernière question peut être ?

Merci beaucoup pour le code

 

[ShuarS]

Ouf j'ai enfin trouvé ^^
Merci à vous pour vos retours.

With Intersect(.Range("A2:A" & .Rows.Count).SpecialCells(xlCellTypeConstants).EntireRow, .[D:Q])
    
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=JOURSEM(D$1;2)>5"
        .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .Pattern = xlLightUp
            .PatternColor = 255
            .ColorIndex = xlAutomatic
            .PatternTintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        
End With

Faut il clôturer les discussions résolues ?

 

[xUpsilon]

Re,

Désolé je n'étais plus sur mon ordinateur
Les discussions résolues sont à indiquer dans "modifier le titre" puis dans le menu déroulant dans lequel tu as indiqué Office 365 tu peux remplacer Office 365 par Résolu

Bonne continuation

 

[ShuarS]

Impec merci