Coloriage plage de cellule planning

Bonjour le forum !

Je travaille sur un planning de réservation (je remercie LouReed pour son aide déjà) et maintenant plus spécifiquement, ma demande concerne le coloriage d'une plage de cellule + écriture d'informations sur cette plage A PARTIR d'un formulaire. (J'ai vu des solutions avec des MFC mais directement depuis excel, et non le dév VBA :/).

J'ai l'information sur les lignes et les colonnes :

• sur les lignes : 2 DatePicker (date de début / date de fin) que l'utilisateur choisi
• sur les colonnes : planning

Je souhaiterai colorier une ligne de cellule entre 2 dates (en vérifiant si la plage de cellule est libre) après avoir valider le formulaire. J'ai le processus en tête mais le "coder" est plus compliqué...

Mon problème : je ne vois pas comment faire ce lien entre excel et vba (parcourir toutes les cellules, et colorier exactement les bonnes cellules)

Merci à toutes les personnes dans la réalisation de mon outil ! (Si nécessaire, je fournirai le fichier)

Bonjour,

Fournis ton fichier et je te donne un exemple de code VBA.

Bonjour Thev ! Voir le fichier en PJ.

(des bouts de codes sont en commentaires intentionnellement )

Bonsoir,

ci-joint version avec remplissage du planning

1- Etant en version 64 bits, j'ai dû ajouter mon propre calendrier car le contrôle DTPicker n'est pas reconnu dans cette version.

2- Ajout d'un bouton pour affecter la couleur du projet sur le planning

Bonsoir

bon voila un bout de la macro

Private Sub BoutonReserver_Click()
     ValeurPoste = ListeDeroulantePoste.Value
    ValeurDomaine = ListeDeroulanteDomaine.Value
    ValeurSecteur = ListeDeroulanteSecteur.Value
    ValeurNom = Me.TextBox_Nom.Value
    ValeurPrenom = Me.TextBox_Prenom.Value
    ValeurProjet = Me.TextBox_Projet.Value
    ValeurDateDebut = Me.DateDebutReservation.Value
    ValeurDateFin = Me.DateFinReservation.Value

Ligne = Range("C4:C24").Find(ValeurPoste).Row
Pos1 = Application.Match(CLng(CDate(DateDebutReservation.Value)), Range("F2:NH2").Value2, 0)
Pos2 = Application.Match(CLng(CDate(DateFinReservation.Value)), Range("F2:NH2").Value2, 0)
 For c = Pos1 To Pos2
    Cells(Ligne, c).Interior.Color = RGB(174, 240, 194)
 Next

A+

Maurice

@thev incroyable, exactement ce que je cherchais ! Merci

Il y a quelques points que j'essaye de corriger dans ce que tu as ajouté au niveau du contrôle et du remplissage dans le planning (chevauchement indiqué, mais le remplissage se fait quand même :/ et l'envoi du mail aussi, alors que ça ne devrait pas)

@archer Merci à toi, je testerai ça sur un autre projet

Bonjour

Mise en forme Coditionelle a revoir ?

voila une autre version a toi de voir

A+

Maurice

Bonjour,

Fraancis a écrit :

chevauchement indiqué, mais le remplissage se fait quand même :/ et l'envoi du mail aussi, alors que ça ne devrait pas)

correction apportée via la remontée au niveau du module, de la variable booléenne : plage_occupée

Bonjour,

Je complète ma précédente réponse avec la prise en compte du contrôle sur la présence des dates dans le planning (erreur sur l'année) .

Bonjour,

Bien vu Thev, j'étais parti dans ce sens mais avec un code un peu plus basique.

Tout dernier point que je cherche à corriger, c'est cette partie du code :

'remplissage planning
            If j1 <> 0 And j2 <> 0 Then
                plage_occupée = False
                If Cells(i, j1) = Empty Then .Cells(i, j1) = TextBox_Projet Else plage_occupée = True
                For j = j1 To j2
                    If .Cells(i, j).Interior.Color <> 16777215 Then plage_occupée = True
                    If plage_occupée Then Exit For
                    .Cells(i, j).Interior.Color = TextBox_Projet.BackColor
                    Next j
            End If

En effet, même s'il y a chevauchement, les cellules se colorent :/ si j'ai bien compris, on vérifie chaque cellule sur la colonne définie plus tôt dans le code, puis on les parcourt. Cependant, la 1ère case sera "Empty" et donc se colorera :/ or ce n'est pas le résultat voulu.

J'ai testé de faire des modifications, mais sans succès à cette heure.

Je vous tiens au courant Si vous réussissez de votre côté, je vous remercie

Bonsoir,

Cette modif devrait faire l'affaire :

            'remplissage planning
            If j1 <> 0 And j2 <> 0 Then
                plage_occupée = False
                If Cells(i, j1) = Empty Then .Cells(i, j1) = TextBox_Projet Else plage_occupée = True
                For j = j1 To j2
                    If .Cells(i, j).Interior.Color <> 16777215 Then
                        plage_occupée = True
                        For k = j-1 To j1 Step -1: .Cells(i, k).Interior.Color = 16777215: Next k
                        Exit For
                    End If
                    .Cells(i, j).Interior.Color = TextBox_Projet.BackColor
                    Next j
            End If

Merci pour votre retour Thev, mais cela rempli toujours la 1ère cellule de la plage de celllule :/

Je regarde de mon côté, et je vous tiens au courant !

Bonjour,

ça devrait régler ce dernier problème

            'remplissage planning
            If j1 <> 0 And j2 <> 0 Then
                plage_occupée = False
                If Cells(i, j1) = Empty Then .Cells(i, j1) = TextBox_Projet
                For j = j1 To j2
                    If .Cells(i, j).Interior.Color <> 16777215 Then
                        plage_occupée = True
                        Cells(i, j1) = Empty
                        For k = j - 1 To j1 Step -1: .Cells(i, k).Interior.Color = 16777215: Next k
                        Exit For
                    End If
                    .Cells(i, j).Interior.Color = TextBox_Projet.BackColor
                    Next j
            End If

Re, pour faire plus propre, j'ai remplacé le :

   For k = j - 1 To j1 Step -1: .Cells(i, k).Interior.Color = 16777215: Next k
                        Exit For

par

For k = j - 1 To j1 Step -1: .Cells(i, k).Interior.Color = xlNone: Next k
                        Exit For

(On met un remplissage None, et non une couleur blanche )

Okay, ça fonctionne, bien. J'ai testé différents cas, et lorsque j'indique une date de début identique à une autre, ça fait :

If .Cells(i, j).Interior.Color <> 16777215 Then ' si couleur
                        plage_occupée = True
                        Cells(i, j1) = Empty 'on vide la première case
                        For k = j - 1 To j1 Step -1: .Cells(i, k).Interior.Color = xlNone: Next k
                        Exit For
                    End If

Et donc par conséquent, ça vide la 1ère cellule et supprime le nom du projet qui était indiqué précédemment :/

C'est vrai qu'il est toujours mieux d'utiliser les constantes Excel. Autant faire également la modif sur l'instruction du haut :

                    If .Cells(i, j).Interior.Color <> xlNone Then
                        plage_occupée = True
                        Cells(i, j1) = Empty
                        For k = j - 1 To j1 Step -1: .Cells(i, k).Interior.Color = xlNone: Next k
                        Exit For
                    End If

thev a écrit :

C'est vrai qu'il est toujours mieux d'utiliser les constantes Excel. Autant faire également la modif sur l'instruction du haut :

                    If .Cells(i, j).Interior.Color <> xlNone Then
                        plage_occupée = True
                        Cells(i, j1) = Empty
                        For k = j - 1 To j1 Step -1: .Cells(i, k).Interior.Color = xlNone: Next k
                        Exit For
                    End If

Re, nope, ne fonctionne pas (considère un emplacement vide comme chevauchement) pour la toute première ligne avec le x1None. Du coup, j'ai laissé comme avant, ça fonctionne très bien

Nous touchons au but !

J'ai déplacé 1 ligne pour le remplissage, j'ai réussi à corriger un petit bug.

Seulement, sur une plage de cellule occupée, si je prends une date de début avant et une date pendant/après la fin, j'ai des cellules noires qui apparaissent :/ Voyez plutôt par vous même

Bonsoir,

En testant dès le départ le chevauchement, ce sera plus simple

            'remplissage planning
            If j1 <> 0 And j2 <> 0 Then
                If Range(.Cells(i, j1), .Cells(i, j2)).Interior.Color = 16777215 Then plage_occupée = False _
                Else plage_occupée = True
                If Not plage_occupée Then
                    For j = j1 To j2
                        .Cells(i, j).Interior.Color = TextBox_Projet.BackColor
                        If .Cells(i, j1) = Empty Then .Cells(i, j1) = TextBox_Projet
                        Next j
                    End If
            End If

NB : Je m'aperçois que vous utilisez la fonction "NO.SEMAINE(G2)". Cette fonction ne respecte pas la norme ISO appliquée pour le calendrier français et peut donc fournir un résultat erroné selon l'année. Il faut utiliser la fonction "NO.SEMAINE.ISO(G2)".

(Pour info, la norme ISO est que le premier jeudi de l'année est dans la semaine 1).

Merci pour ta précieuse aide Thev ! Cela fonctionne !

Une toute dernière précision, est-il possible de vérifier si la date de début et après la date de fin de réservation ? (par ex : 08/03 au 06/03)

C'est le choix inverse de date un élément qui casse le système

Bien sûr.

Il suffit juste d'insérer ce contrôle avant le remplissage du planning.