XL 2019 [VB] Organisation et gestion du ménage et de l'entretien global (à améliorer)... Comment procéder ?

  • Initiateur de la discussion Initiateur de la discussion anthoYS
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

anthoYS

XLDnaute Barbatruc
Bonjour


Voilà, le classeur joint téléchargeable en bas où ici en cliquant ci-après (>> Classeur9.xlsx <<)...
L'objectif est de trouver un code permettant de colorer de vert les losanges ... du jour concerné qui correspond à aujourd'hui et uniquement si c'est la bonne semaine, etc. et un calendrier (agenda) permettant de savoir quand commence telle semaine etc. dans un second onglet ou un agenda à côté calendrier... ?

On va partir du postulat que la semaine 1 est celle en cours (depuis lundi 3 novembre 2025)...

ce code n'est sans doute pas adapter, comment le modifier en conséquence pour qu'il rende le fichier opérationnel?

VB:
Sub ColorerLosanges()
    Dim wsCalendrier As Worksheet
    Dim wsAgenda As Worksheet
    Dim annee As Integer
    Dim mois As Integer
    Dim premierJour As Date
    Dim dernierJour As Date
    Dim i As Integer, j As Integer
    Dim dateCell As Date
    Dim semaineBonne As Boolean
    Dim numSemaine As Integer

    ' Définir les feuilles
    Set wsCalendrier = ThisWorkbook.Sheets("Calendrier")
    Set wsAgenda = ThisWorkbook.Sheets("Agenda")

    ' Effacer les couleurs existantes
    wsCalendrier.Cells.Interior.ColorIndex = xlNone

    ' Récupérer l'année et le mois (à adapter selon tes besoins)
    annee = wsCalendrier.Range("B1").Value ' Supposons que l'année est en B1
    mois = wsCalendrier.Range("B2").Value  ' Supposons que le mois est en B2

    ' Calculer le premier jour du mois
    premierJour = DateSerial(annee, mois, 1)
    dernierJour = DateSerial(annee, mois + 1, 1) - 1

    ' Boucle pour chaque jour du mois
    For i = 1 To Day(dernierJour)
        dateCell = DateSerial(annee, mois, i)
        numSemaine = DatePart("ww", dateCell, vbMonday) ' Numéro de la semaine

        ' Vérifier si la semaine est "bonne" dans l'onglet Agenda
        semaineBonne = (wsAgenda.Range("B" & numSemaine + 1).Value = "Bonne")

        ' Colorer le losange en vert si la semaine est bonne
        If semaineBonne Then
            ' Supposons que les losanges sont dans la plage D10:AF30 (à adapter selon ton fichier)
            wsCalendrier.Cells(9 + Int((i - 1) / 7), 4 + ((i - 1) Mod 7)).Interior.Color = RGB(0, 255, 0) ' Vert
        End If
    Next i
End Sub

Nota : le code joint n'est pas incorporer dans le fichier (*.xlsx actuellement).
Vous pouvez très bien fournir une copie en *xlsm.



Merci beaucoup d'avance !
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour