XL 2019 coloriage cellules

[Did25]

Bonjour je souhaiterais pouvoir faire un balayage grossier de mon tableau pour en colorier les cellules avec ma macro jours 1et qu'elle ne prenne en compte que certaines colonnes de la sélection à l'identique de la macro commandbutton7 ,par exemple je voudrais pouvoir sélectionner toute l'année 2021 et quand je click sur Jours 1 ,ne soit colorié que les colonnes L,O,R,U,X,AA,AD,AG,AJ,AN,AP,AS et que seuls les cellules qui ont un postes associées soient prises en compte pour le coloriage .J'espère que mon explication est claire. Merci par avance .

 

[Bernard_XLD]

voila, c'est fait pour l'ensemble du tableau avec un code vérifiant la concordance sélection/plages à modifier
j'ai aussi modifié ta macro d'effacement des cellules sélectionnées sur le même principe

Dim Cellule_en_Cours As Range, Test_Plage, Compteur As Integer
Private Sub CommandButton1_Click()
    'bouton CEFC
    For Compteur = 12 To 369 Step 3
        If Compteur >= Selection.Resize(, 1).Column Then
            If Selection.Columns.Count + Selection.Resize(, 1).Column - 1 < Compteur Then Exit For
            Set Test_Plage = Nothing
            Set Test_Plage = Intersect(Range("A4").Offset(0, Compteur - 1).Range("A1:A31"), Selection)
            If Not Test_Plage Is Nothing Then
                For Each Cellule_en_Cours In Test_Plage
                    Cellule_en_Cours.FormulaR1C1 = "5"
                Next Cellule_en_Cours
            End If
        End If
    Next Compteur
End Sub

 

[Bernard_XLD]

Didier,

nouvelle mouture
j'ai modifié le code pour que les valeurs ne s'inscrivent que si il y a une valeur dans la cellule jour (pour éviter en cas de sélection d'aller écrire une valeur les 30 et 31 février ou le 31 avril)
j'ai aussi modifié le code pour aller plus vite, je le trouvais lent sur des grandes sélections
j'ai centralisé le code d'écriture de valeur dans une seule proc
j'ai aussi modifié tes macros d'effacement sur le même principe
j'en ai profité pour documenter le code
Dis moi si cela convient

Bien cordialement

Dim Cellule_en_Cours As Range, Test_Plage, Compteur As Integer
Private Sub Inscription_Indisponibilites(Val_Indispo$)
    With Application
        .ScreenUpdating = False 'désactivation de l'affichage écran
        .Calculation = xlCalculationManual 'désactivation du calcul automatique
        .EnableEvents = False 'désactivation des événements
    End With
    On Error GoTo Gere_Erreurs 'si erreur on réactive tout (ceinture et bretelles)
    For Compteur = 12 To 369 Step 3 'compte de la premiere colonne du tableau à la dernière par incrémentation de 3
        If Compteur >= Selection.Resize(, 1).Column Then 'ne déclenche le code que si compteur supérieur ou égal à la première colonne de la sélection
            If Selection.Columns.Count + Selection.Resize(, 1).Column - 1 < Compteur Then Exit For 'sort de la boucle si compteur supérieur à la dernière colonne de la sélection
            Set Test_Plage = Nothing 'efface la référence
            Set Test_Plage = Intersect(Range("A4").Offset(0, Compteur - 1).Range("A1:A31"), Selection) 'récurère l'intersection sélection plage à modifier, reste à nothing si aucune
            If Not Test_Plage Is Nothing Then ' si plage d'intersectionb existe, exécute
                For Each Cellule_en_Cours In Test_Plage 'pour chaque cellule de la plage d'intersection
                    If Not Cellule_en_Cours.Offset(0, -2).Value = "" Then Cellule_en_Cours.FormulaR1C1 = Val_Indispo 'si valeur en même ligne, colonne -2, applique la valeur
                Next Cellule_en_Cours
            End If
            Set Test_Plage = Nothing 'efface la référence (ceinture et bretelles)
        End If
    Next Compteur
Gere_Erreurs:
    With Application
        .ScreenUpdating = True 'activation de l'affichage écran
        .Calculation = xlCalculationAutomatic 'activation du calcule automatique
        .EnableEvents = True 'activation des événements
    End With
End Sub
Private Sub CommandButton1_Click()
    'bouton CEFC
    Inscription_Indisponibilites ("5")
End Sub
Private Sub CommandButton2_Click()
    'bouton 3/4 temps
    Inscription_Indisponibilites ("8")
End Sub
Private Sub CommandButton4_Click()
    'bouton CAFC
    Inscription_Indisponibilites ("6")
End Sub
Private Sub CommandButton5_Click()
    'bouton TB6
    Inscription_Indisponibilites ("9")
End Sub
Private Sub commandbutton3_click()
    'bouton congés
    Inscription_Indisponibilites ("7")
End Sub
Private Sub CommandButton6_Click()
    With Application
        .ScreenUpdating = False 'désactivation de l'affichage écran
        .Calculation = xlCalculationManual 'désactivation du calcul automatique
        .EnableEvents = False 'désactivation des événements
    End With
    On Error GoTo Gere_Erreurs 'si erreur on réactive tout (ceinture et bretelles)
    For Compteur = 12 To 369 Step 3 'compte de la premiere colonne du tableau à la dernière par incrémentation de 3
        If Compteur >= Selection.Resize(, 1).Column Then 'ne déclenche le code que si compteur supérieur ou égal à la première colonne de la sélection
            If Selection.Columns.Count + Selection.Resize(, 1).Column - 1 < Compteur Then Exit For 'sort de la boucle si compteur supérieur à la dernière colonne de la sélection
            Set Test_Plage = Nothing 'efface la référence
            Set Test_Plage = Intersect(Range("A4").Offset(0, Compteur - 1).Range("A1:A31"), Selection) 'récurère l'intersection sélection plage à modifier, reste à nothing si aucune
            If Not Test_Plage Is Nothing Then Test_Plage.ClearContents ' si plage d'intersectionb existe, l'efface
            Set Test_Plage = Nothing 'efface la référence (ceinture et bretelles)
        End If
    Next Compteur
Gere_Erreurs:
    With Application
        .ScreenUpdating = True 'activation de l'affichage écran
        .Calculation = xlCalculationAutomatic 'activation du calcule automatique
        .EnableEvents = True 'activation des événements
    End With
End Sub
Private Sub CommandButton7_Click()
    With Application
        .ScreenUpdating = False 'désactivation de l'affichage écran
        .Calculation = xlCalculationManual 'désactivation du calcul automatique
        .EnableEvents = False 'désactivation des événements
    End With
    On Error GoTo Gere_Erreurs 'si erreur on réactive tout (ceinture et bretelles)
    For Compteur = 12 To 369 Step 3 'compte de la premiere colonne du tableau à la dernière par incrémentation de 3
        Range("A4").Offset(0, Compteur - 1).Range("A1:A31").ClearContents 'on efface les plages de valeurs
    Next Compteur
Gere_Erreurs:
    With Application
        .ScreenUpdating = True 'activation de l'affichage écran
        .Calculation = xlCalculationAutomatic 'activation du calcule automatique
        .EnableEvents = True 'activation des événements
    End With
End Sub

 

[Did25]

Merci Yeahou ,j'ai fait des essais mais je rencontre un pb avec le comptage cellule,sur un mois j'obtiens 31 jours au lieu de jours postés ,il faut que je trouve la solution avec ma formule :=NB.SI(J4:NE34;D2) mais pour le reste c'est le top parfait merci beaucoup

 

[Bernard_XLD]

dans ce cas la, on peut écrire les valeurs uniquement quand il y a un jour posté

 

[Bernard_XLD]

avec le code c'est mieux

Private Sub Inscription_Indisponibilites(Val_Indispo$)
    With Application
        .ScreenUpdating = False 'désactivation de l'affichage écran
        .Calculation = xlCalculationManual 'désactivation du calcul automatique
        .EnableEvents = False 'désactivation des événements
    End With
    On Error GoTo Gere_Erreurs 'si erreur on réactive tout (ceinture et bretelles)
    For Compteur = 12 To 369 Step 3 'compte de la premiere colonne du tableau à la dernière par incrémentation de 3
        If Compteur >= Selection.Resize(, 1).Column Then 'ne déclenche le code que si compteur supérieur ou égal à la première colonne de la sélection
            If Selection.Columns.Count + Selection.Resize(, 1).Column - 1 < Compteur Then Exit For 'sort de la boucle si compteur supérieur à la dernière colonne de la sélection
            Set Test_Plage = Nothing 'efface la référence
            Set Test_Plage = Intersect(Range("A4").Offset(0, Compteur - 1).Range("A1:A31"), Selection) 'récurère l'intersection sélection plage à modifier, reste à nothing si aucune
            If Not Test_Plage Is Nothing Then ' si plage d'intersectionb existe, exécute
                For Each Cellule_en_Cours In Test_Plage 'pour chaque cellule de la plage d'intersection
                    With Cellule_en_Cours
                        If Not .Offset(0, -2).Value = "" And (.Offset(0, -1).Value = "A" Or .Offset(0, -1).Value = "M" Or .Offset(0, -1).Value = "N") Then .FormulaR1C1 = Val_Indispo 'si valeur en même ligne, colonne -2 et service posté, applique la valeur
                    End With
                Next Cellule_en_Cours
            End If
            Set Test_Plage = Nothing 'efface la référence (ceinture et bretelles)
        End If
    Next Compteur
Gere_Erreurs:
    With Application
        .ScreenUpdating = True 'activation de l'affichage écran
        .Calculation = xlCalculationAutomatic 'activation du calcule automatique
        .EnableEvents = True 'activation des événements
    End With
End Sub

 

[Did25]

Parfait c'est trop top merci Yeahou merci XLD

 

[Bernard_XLD]

par contre tu ne verras pas si un utilisateur a écrit une valeur manuellement à un mauvais endroit
sinon tu peux protéger ta feuille et déverrouiller/entrée ou suppression de valeur/verrouiller par macro
ou enlever le test des services postés pour la MFC

 

[Did25]

Bonjour Yeahou ,pour protéger la feuille ,tu parles de la mise en place d'une macro avec la fonction déverrouillage entrée ou suppression de valeurs, pourquoi pas mais pour ce qui des MFC je ne vois pas ce que tu veux dire
Cdlt@+

 

[Bernard_XLD]

Bonjour Didier, le forum

la MFC n'agit que s'il y a un service posté, cela cache donc les valeurs entrées quand il n'y a pas de service posté puisque tu as défini un format d'affichage pour masquer les valeurs, donc toute saisie manuelle est source potentielle d'erreur sans que cela apparaisse visiblement.
on pourrait prévoir une macro qui vérifie que ce cas n'existe pas ou modifier la MFC pour que le format d'affichage ne soit modifié que quand la condition est remplie, cela ferait ressortir les problèmes
on peut aussi passer la couleur de fond en rouge quand une valeur est entrée sans que la condition soit remplie.

Bien cordialement

 

[Did25]

Bonjour Yeahou ,le plus simple est le plus sur serait de bloquer toutes modifications qui n'est pas effectué par les boutons et d'autoriser uniquement les changements de postes sur les tableaux de cycles ,mais là je ne saurais faire

 

[Bernard_XLD]

re bonjour Didier

ok, je coderai ça cet aprèm

d'autoriser uniquement les changements de postes sur les tableaux de cycles

tu veux dire quoi par ça ?

 

[Bernard_XLD]

tu veux dire quoi par ça ?

ok, j'ai compris en regardant tes formules, à ma décharge, je n'avais jamais vu monter un roulement comme cela.

 

[Did25]

Bonjour Yeahou j'ai utilisé ce principe pour pouvoir adapter en fonction des équipes ce qui me donne plus de flexibilité en fonction de la date de départ des postes de certaines équipes .

 

[Bernard_XLD]

Bonjour Didier, le forum

l'important, c'est que ça fonctionne, le roulement est très simple, un seul cycle sur dix jours.
ta couverture de poste est identique quelque soit le type jour ?
si je ne me trompe, ils doivent travailler une moyenne de 08h20 par jour, des trois/huit sans doute avec une partie habillement ou superposition de relève pour le passage des consignes.

sinon je n'ai pas encore codé ta protection , je vais quand même essayer de te faire ça rapidement

Bien cordialement, @+

 

[Bernard_XLD]

Bonjour Didier, le forum

je t'ai fait un truc simple dans le module de feuille, code "toto" en constante
les macros fonctionneront, elles remettent le code une fois exécuté
l'activation ou la désactivaction de la feuille remet le code
tu n'as plus qu'à déverrouiller manuellement la feuille pour définir la propriété des cellules non protégées ou avant de changer le mot de passe dans le module.
si tu ne veux pas de mot de passe mais seulement une protection anti bétise désactivable par tout le monde, rentres une chaine vide en mot de passe("")
n'oublies pas de protéger l'accès au projet dans VBE, outils/propriétés/onglet protection sinon tout le monde pourra lire le mot de passe

Bien cordialement