Mise en forme conditionnelle ou Avertissement Macro

Bonjour, j'aimerais soit grâce à une mise en forme conditionnelle ou éventuellement une macro, une sorte d'alerte montrant qu'il y a une erreur sur le fichier.

Sur l'exemple suivant la Colonne "I" permet de vérifier que l'agent est présent ou pas. A partir du moment ou il est doit travailler, il y a le chiffre 1 qui apparait mais il ne faut pas qu'il y ai plus de 7 fois le chiffre "1"d'affilé.

Si c'est >=7 alors soit il y a une coloration en rouge des cellules concernées dans la colonne (I),ceci permettrait de montrer l'erreur.

Ou sinon un message d'erreur, comme quoi l'agent va travailler 7 jours d'affilés.

Merci pour votre aide, car je ne vois pas comment faire.

15exemple-ps.xlsx (23.49 Ko)

Bonjour

Un essai à tester. Te convient-il ?

Bye !

13exemple-ps-v1.xlsm (21.24 Ko)

Merci à toi, cela fonctionne parfaitement sur mon exemple. Mais lorsque j'intègre ton code dans mon classeur, cela ne fonctionne plus.

A mon avis, je ne sais pas ou le placer car j'ai déjà un code VBA dessus. Je l'ai rajouté à la suite mais ça ne fonctionne pas.

Peux-tu svp me dire ou le mettre

Merci

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom, Periode As String
Dim Hs_Norm, HS_Ferie, HS_Nuit, Total As Single
Dim DrLigne, A As Integer
Dim Test As Boolean
Application.EnableEvents = False
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("AGENTS_MATIN").Activate
deprotege

If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
    For i = 32 To 35
        If format(ThisWorkbook.Worksheets("AGENTS_MATIN").Cells(i, 2), "dd") > 20 Then

            ThisWorkbook.Worksheets("AGENTS_MATIN").Rows(i + 10).Hidden = True

            ThisWorkbook.Worksheets("AGENTS_MATIN").Cells(i, 5) = ""

            ThisWorkbook.Worksheets("AGENTS_MATIN").Cells(i, 6) = ""

            ThisWorkbook.Worksheets("AGENTS_MATIN").Cells(i, 7) = ""

        Else

            ThisWorkbook.Worksheets("AGENTS_MATIN").Rows(i + 10).Hidden = False

            ThisWorkbook.Worksheets("AGENTS_MATIN").Cells(i, 5).FormulaLocal = "=SI(ESTERREUR(TROUVE(""|"";$D" & i & ";1));SIERREUR(RECHERCHEV($D" & i & ";'[Planning Agents ENC Matin.xlsm]RIPPEURS'!$K:$K;1;FAUX);"""");GAUCHE($D" & i & ";TROUVE(""|"";$D" & i & ";1)-2))"

            ThisWorkbook.Worksheets("AGENTS_MATIN").Cells(i, 6).FormulaLocal = "=SI(ESTERREUR(TROUVE(""|"";$D" & i & ";1));SIERREUR(RECHERCHEV($D" & i & ";'[Planning Agents ENC Matin.xlsm]RIPPEURS'!$K:$K;1;FAUX);$D" & i & ");GAUCHE($D" & i & ";TROUVE(""|"";$D" & i & ";1)-2))"

            ThisWorkbook.Worksheets("AGENTS_MATIN").Cells(i, 7).FormulaLocal = "=SI(ESTERREUR(TROUVE(""|"";D" & i & ";1));SIERREUR(RECHERCHEV($D" & i & ";'[Planning Agents ENC Matin.xlsm]RIPPEURS'!$K:$N;4;FAUX);"""");STXT(D" & i & ";TROUVE(""|"";D" & i & ";1)+2;999))"

        End If
    Next
    Sheets("AGENTS_MATIN").Calculate
End If
protege
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
    UserFAgent.Show
ElseIf Target.Row <> 2 And Target.Column <> 1 Then
    ThisWorkbook.Worksheets("AGENTS_MATIN").Cells(50, 1).Select
End If
End Sub
Sub divers()
Application.EnableEvents = True
End Sub

Option Explicit

Dim plage As Range
Dim ln&, k&, nbJ

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("AB15:AB45")) Is Nothing Then
        Range("AB15:AB45").Interior.Color = xlNone
        k = 0: nbJ = 0
        For ln = 15 To 39
            Set plage = Range("AB" & ln & ":AB" & ln + 6)
            If WorksheetFunction.Sum(plage) >= 7 Then
                plage.Interior.Color = RGB(255, 0, 0)
            End If

        Next ln
    End If
End Sub

Bonjour

Tu devrais expliquer ce que tes macros sont sensées faire, et surtout leur conditions de déclenchement...

En particulier, je ne vois pas l'intérêt des instructions

...
If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
    For i = 32 To 35
...

Bye !

L'instruction suivante

If Not Application.Intersect(Target, Range("A3")) Is Nothing Then
    For i = 32 To 35
        If format(ThisWorkbook.Worksheets("AGENTS_MATIN").Cells(i, 2), "dd") > 20 Then

Permet de masquer les dates du mois suivant qui sont supérieur à 20, car je ne veux faire apparaître que des dates du 21 du mois en court au 20 du mois suivant.

J'ai rajouté en pièce jointe, le fichier quasiment complet et j'aimerais pouvoir intégrer ton code pour qu'il y ai un avertissement au niveau de la colonne AB.

Encore merci de ton aide

6exemple-ps-v2.xlsm (484.01 Ko)

Bonjour

Nouvel essai.

Bye !

11exemple-ps-v3.xlsm (454.50 Ko)

Merci à toi, c'est exactement ce qu'il me fallait afin de percevoir immédiatement les erreurs.

Par contre, une fois l'erreur corriger, la couleur rouge ne disparait pas, il faut changer de nom en cellule A1 et ensuite revenir sur le nom portant l'erreur pour que la couleur rouge disparaisse.

N'existe t'il pas un moyen pour que cette couleur disparaisse immédiatement, une fois la correction apportée.

Merci

correction apportee mais le rouge reste correction apportee mais pour que le rouge faire un changement de nom

Bonjour

A défaut de savoir comment tu corriges l'erreur, je t'ai mis un bouton.

Cela te convient-il ?

Bye !

8exemple-ps-v4.xlsm (455.58 Ko)

Merci à toi

Je corrige l'erreur grâce à un autre fichier excell qui est en liaison avec celui-ci avec la fonction INDEX ET EQUIV. Il suffit que je change un intitulé dans l'autre fichier pour que le chiffre 1 disparaisse de la colonne Q et par conséquent de la colonne AB.

Sur la capture suivante pour la journée du sam 18/05/19, j'avais au départ en colonne D le mot "ENC MATIN" et par conséquent le chiffre "1" en colonne Q et en AB. Ce qui grâce à ton code VBA me permet de voir que j'ai commis une erreur sur mon autre fichier car l'agent dans se cas à travaillé plus de 6 jours consécutifs. Une fois la correction faite sur l'autre fichier, en remplaçant "ENC MATIN" par "REPOS", le chiffre 1 disparait de la colonne Q mais également de la colonne AB. Mais la couleur rouge reste et j'aimerais qu'elle disparaisse, car j'ai apporté la correction.

En cliquant sur ton bouton, j'ai un message d'erreur "Visual basic 400"

Merci

capture d ecran 2019 05 26 a 10 59 06

J'ai remarqué que lorsque je retire la protection sur la feuille ton bouton fonctionne correctement, une fois la correction apportée sur mon autre fichier, le chiffre 1 disparait normalement en colonne Q et en AB, et en appuyant sur ton bouton, la couleur rouge disparait sans être obligé de changer de nom en cellule A1.

Par contre si je ne retire pas la protection, alors j'ai le message d'erreur "visual basic 400" et ton bouton ne fonctionne pas.

Il faut absolument que je protège entièrement cet onglet, car il est rempli que de formule et le fait d'enlever une formule rendrait ce fichier inutilisable.

Je pense que pour que ton bouton fonctionne il faut mettre "deprotege" et "protege" quel que part dans ton code, mais je ne sais pas ou?

Merci

je crois que j'ai trouvé d'ou venais l'erreur, en rajoutant deprotege et protege

Sub Verif()
deprotege
        Range("AB15:AB44").Interior.Color = xlNone
        k = 0: nbJ = 0: flag = 0
        For ln = 15 To 38
            Set plage = Range("AB" & ln & ":AB" & ln + 6)
            If WorksheetFunction.Sum(plage) >= 7 Then
                plage.Interior.Color = RGB(255, 0, 0)
                flag = 1
            End If
        Next ln
        If flag = 1 Then
            MsgBox "ATTENTION, l'agent a travaillé plus de 6 jours consécutifs, merci de corriger le planning agent.", 16
        End If
protege
End Sub

Sub divers()
    Application.EnableEvents = True
End Sub

je pense que cette fois c'est ok

Qu'en penses-tu?

Essaie ainsi :

Sub Verif()
        Call deprotege
        Range("AB15:AB44").Interior.Color = xlNone
        k = 0: nbJ = 0: flag = 0
        For ln = 15 To 38
            Set plage = Range("AB" & ln & ":AB" & ln + 6)
            If WorksheetFunction.Sum(plage) >= 7 Then
                plage.Interior.Color = RGB(255, 0, 0)
                flag = 1
            End If
        Next ln
        If flag = 1 Then
            MsgBox "La durée maximale de 6 jours consécutifs n'est pas respectée.", 16
        End If
       Call protege
End Sub

Bye !

Dans le même style de macro que la précédente, est-il possible d'avoir une macro que lorsque la cellule Z46 est > 35 dans l'exemple PS V3, et bien il y a un message d'alerte "Attention, nbr d'heures supplémentaires supérieur à 35H, ce n'est pas possible, merci de corriger"

Encore merci de votre aide.

2exemple-ps-v3.xlsm (454.50 Ko)
Rechercher des sujets similaires à "mise forme conditionnelle avertissement macro"