MSGBOX lorsque des cellules ont une certaine couleur

Le 21/08/2018 à 20:18

Bonjour à tous.

J'ai une feuille de calcul et précisément une colonne, ou je mets en couleur Rose foncé les cellules qui sont en doublons.

Si cette situation se produit, c'est qu'il y a une anomalie qui n'est pas acceptable pour le calcul et la gestion des feuilles suivantes.

Ce constat peut se produire si l'on a saisi des informations dans d'autres feuilles. Pour l'instant je n'ai pas trouvé d'autres solutions.

N'étant pas très avancé en connaissance VBA j'ai essayé de créer une macro qui permettrait d'afficher un message mettant en alerte cette anomalie.

Il faudrait que ce message s'active dès l'instant ou il y a détection des doublons.

Voici ce que j'ai pondu en fouillant un peu, et je vous joins un fichier (Il s'agit d'une feuille parmi celles qui sont dans mon fichier d'étude)

Sub Contrôle_Activite_Doublon()

' Contrôle_Activite_Doublon Macro

' On teste si dans la feuille vente, il n'y a pas le même code activité dans la section commerciale et la section activité propre

Sheets("Ventes").Select

Range("H10:K37").Select

If (Selection.Interior.ColorIndex = 15261367) Then

MsgBox ("ATTENTION il est impératif de ne pas avoir des catégories d'activité identique dans la partie commerciale et la partie Activité propre")

End If

End Sub

Ne me jugez pas trop si cette ligne de commande vous fait sourire quelque peu, il y a un début à tout.

Merci par avance pour votre retour, si vous avez une solution, qui n'est de toute façon pas bloquante dans l'immédiat.

34gestion-des-doublons.xlsm (27.23 Ko)

Le 21/08/2018 à 22:24

Salut Bruce,

facile mais tu dis :

Ce constat peut se produire si l'on a saisi des informations dans d'autres feuilles.

Est-ce à dire que ce genre d'incident peut se produire dans n'importe quelle feuille ?
Faut-il donc rechercher des doublons dans chaque feuille, colonne [A] ? D'autres colonnes ? Dans quelles feuilles?
Tes rubriques en [A] n'ont-elles systématiquement qu'une couleur différente pour les différencier ?

Le cas échéant, tu n'aurais pas d'autres feuilles à proposer qui illustreraient des particularités de recherche de ces doublons?

Bref, des infos utiles...

A+

Le 21/08/2018 à 23:39

Bonjour,

Je maitrise la gestion des doublons pour uniquement cette feuille, dans le sens ou si ça se produit les doublons sont mis en évidence par le jeu des couleurs. Il n'y a donc pas de recherche de doublons dans les autres feuilles.

Je voulais juste dire que cette feuille est liée par d'autres calculs et critères qui se trouvent dans d'autre feuilles, et qui peut amener que cette feuille est des doublons.

En fait quelque soit ou l'on se trouve dans le classeur, si cette feuille par le biais d'un calcul il survient des doublons, il faudrait être avisé par une MSGBOS.

En résumé :

Il faut une alerte par une msgbox si cette feuille présente des doublons, mais pas seulement et pas forcément au moment ou on visualise cette feuille.

Je reste à votre écoute.

Merci par avance

Le 21/08/2018 à 23:42

J'ai oublié de préciser, les doublons mis en évidence sur cette feuille ont tous le même code couleur rouge. Si la couleur des cellules est différent de rouge, la feuille est OK

Merci par avance

Le 22/08/2018 à 00:33

Salut Bruce,

macro à coller dans le module VBA de 'ThisWorkbook'

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim sData$
'
With Worksheets("Ventes")
    iRow = .Range("A" & Rows.Count).End(xlUp).Row
    For x = 1 To iRow - 1
        If WorksheetFunction.CountIf(.Range("A" & x + 1 & ":A" & iRow), .Range("A" & x).Value) > 0 And Len(.Range("A" & x).Value) > 2 Then _
            sData = sData & IIf(sData = "", .Range("A" & x).Value, Chr(10) & .Range("A" & x).Value)
    Next
    If sData <> "" Then _
        MsgBox "                                 ! ATTENTION !" & Chr(10) & "Il est impératif de ne pas avoir des catégories d'activité identiques" & _
        Chr(10) & "dans la partie commerciale et la partie Activité propre." & Chr(10) & Chr(10) & sData, vbCritical + vbOKOnly, "Info Doublons"
    .Activate
End With
'
End Sub

A+

Le 22/08/2018 à 10:35

Bonjour, je viens de mettre en place le code et j'avoue que je suis très agréablement étonné, c'est plus que je ne pouvais imaginer.

Ca répond aux critères essentiels :

L'alerte est permanente dès qu'il y a un recalcul.

La validation du message renvoie à la feuille des ventes pour appréhender l'erreur.

J'ai essayé de décrypter rapidement le code, il va me falloir un temps de réflexion et d'analyse.

Encore une fois merci, ça m'enlève une bonne épine du pied, et je suis en plus admiratif...

Bonne journée.

Le 22/08/2018 à 12:57

Bonjour,

Juste un petit point de détail, lorsqu'il y a un doublon et que l'on valide le message, on est renvoyé à la page des ventes.

Petit problème c'est que même s'il n'y a pas de doublon que la conditions est remplie, chaque fois que l'on fait une modification d'une cellule dans l'ensemble du classeur, on est renvoyé à la feuille des ventes.

Je pense avoir compris qu'il s'agit de la fonction .ACTIVATE

Peut-on faire une correction pour que cette fonction soit active uniquement quand il y a des doublons.

Cordialement.

Le 22/08/2018 à 13:20

Salut Bruce,

la correction demandée...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim sData$, sRep$
'
With Worksheets("Ventes")
    iRow = .Range("A" & Rows.Count).End(xlUp).Row
    For x = 1 To iRow - 1
        If WorksheetFunction.CountIf(.Range("A" & x + 1 & ":A" & iRow), .Range("A" & x).Value) > 0 And Len(.Range("A" & x).Value) > 2 Then _
            sData = sData & IIf(sData = "", .Range("A" & x).Value, Chr(10) & .Range("A" & x).Value)
    Next
    If sData <> "" Then _
        sRep = MsgBox("                                 ! ATTENTION !" & Chr(10) & "Il est impératif de ne pas avoir des catégories d'activité identiques" & _
                Chr(10) & "dans la partie commerciale et la partie Activité propre." & Chr(10) & Chr(10) & sData, vbCritical + vbOKCancel + vbDefaultButton2, "Info Doublons")
        If sRep = vbOK Then .Activate
End With
'
End Sub

A+

Le 22/08/2018 à 23:51

Merci bien, c'est parfait !

J'ai pu me servir de cette formule pour traiter d'autres options, et ça fonctionne super bien.

J'ai appris quelque chose ce jour, bravo pour ce partage !!

A bientôt peut-être !

Cordialement

Le 23/08/2018 à 10:35

Bonjour, je me suis inspiré de votre code pour faire un autre contrôle. Je n'arrive pas à trouver la syntaxe pour renvoyer à la cellule concernée après avoir validé la MSGBOX.

La ligne incriminée est la suivante en bas de page : If sRep = vbOK Then Sheets("Ventes").Activate (Ne fonctionne pas)

L'idéale serait de pointer sur la cellule nommée de la page ventes "Heures_Aventiler"

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim sData$

With Worksheets("Ventes")

iRow = .Range("H" & Rows.Count).End(xlUp).Row

For X = 1 To iRow - 1

If WorksheetFunction.CountIf(.Range("H" & X + 1 & ":H" & iRow), .Range("H" & X).Value) > 0 And Len(.Range("H" & X).Value) > 2 Then _

sData = sData & IIf(sData = "", .Range("H" & X).Value, Chr(10) & .Range("H" & X).Value)

If sData <> "" Then _

MsgBox " ! ATTENTION !" & Chr(10) & "Il est impératif de ne pas avoir des catégories d'activité identiques" & _

Chr(10) & "dans la partie Activités commerciales et la partie Activités directes." & Chr(10) & Chr(10) & _

"Si cette anomalie concerne l'activité directe, procéder à la correction dans le tableau qui va s'afficher après validation du présent message." & Chr(10) & _

"Si ça concerne l'activité commerciale, il faut vous rendre dans les Objectifs salariés commerciaux ou/et Agents commerciaux" & Chr(10) & Chr(10) & _

"Voici l'activité qui pose souci :" & Chr(10) & Chr(10) & sData, vbCritical + vbOKOnly, "Info Doublons"

If sRep = vbOK Then .Activate

End With

Dim Heures As Integer

Heures = Range("Heures_Aventiler").Value

If Heures <> 0 Then

MsgBox " ! ATTENTION !" & Chr(10) & " Le total des heures nettes à ventiler sur l'activité directe doit être à zéro." _

& Chr(10) & "Vous avez vraisemblablement apporté des modifications sur vos objectifs. " & Chr(10) & _

"Le total des heures potentielles de l'entreprise est différent du nombre d'heures planifié." & Chr(10) & _

"Vous devez soit : " & Chr(10) & " - Modifier le nombre d'heures planifié" & Chr(10) & " - Ajuster l'effectif de l'entreprise par une embauche ou du personnel intérimaire." _

& Chr(10) & Chr(10) & "A cet instant le nombre d'heures à gérer est de :" & Chr(10) & Chr(10) & _

" " & Heures & "Heures", vbCritical + vbOKOnly, "Info Compteur d'heures à mettre à jour"

If sRep = vbOK Then Sheets("Ventes").Activate

End If

End Sub

Merci par avance de votre réponse

Le 23/08/2018 à 16:09

Salut,

sRep= Msgbox("...")
If sRep= vbOk...

Pas oublier les parenthèses...

A+

Le 23/08/2018 à 21:42

Bonjour,

J'ai mis en application vos recommandations, c'est très fonctionnel.

Merci beaucoup

Bonne continuation

Le 05/09/2018 à 10:30

curulis57 a écrit :

Salut Bruce,

la correction demandée...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim sData$, sRep$
'
With Worksheets("Ventes")
    iRow = .Range("A" & Rows.Count).End(xlUp).Row
    For x = 1 To iRow - 1
        If WorksheetFunction.CountIf(.Range("A" & x + 1 & ":A" & iRow), .Range("A" & x).Value) > 0 And Len(.Range("A" & x).Value) > 2 Then _
            sData = sData & IIf(sData = "", .Range("A" & x).Value, Chr(10) & .Range("A" & x).Value)
    Next
    If sData <> "" Then _
        sRep = MsgBox("                                 ! ATTENTION !" & Chr(10) & "Il est impératif de ne pas avoir des catégories d'activité identiques" & _
                Chr(10) & "dans la partie commerciale et la partie Activité propre." & Chr(10) & Chr(10) & sData, vbCritical + vbOKCancel + vbDefaultButton2, "Info Doublons")
        If sRep = vbOK Then .Activate
End With
'
End Sub

A+

Bonjour,

Je m'étais inspiré de ta solution citée ci-dessus pour faire un deuxième contrôle et précisément sur une cellule qui doit être à zéro si toutes les ventilations des heures sont bien réparties dans les activités.

Ca fonctionne très bien, sauf que l'alerte est intempestive.

Je précise si l'utilisateur entre un nouveau salarié dans une autre feuille par exemple et qu'il doit planifier ses congés payés à chaque cellule modifié (chaque jour), il est renvoyé vers ce message, c'est beaucoup trop lourd.

L'idéale serait de trouver une temporisation. J'avais bien essayé de mettre un compteur de "X" valeur, mais je n'ai pas réussi. Pour cela j'avais créé à la place une INPUTBOX pour insérer un compteur dont le nombre était défini par l'utilisateur. A chaque calcul le compteur se décomptait de 1 pour arriver à zéro. Le contrôle à zéro réaffichait l'inputbox, j'avais des bugs que je n'ai pas réussi à maîtriser.

Y aurait-il une autre piste ? Par exemple le contrôle se réalise si je quitte une des feuille qui est susceptible de modifier ma cellule de contrôle qui se trouve dans ma feuille "Ventes". Sachant que j'ai un contrôle ultime à l'ouverture du ficher.

Merci par avance pour ton conseil...

Ci-dessous, ma ligne de contrôle

'************************************************************

'Contrôle que le potentiel d'heures de production est égale

'au potentiel d'heures facturables

'************************************************************

Dim Heures As Integer

Heures = Range("Heures_Aventiler").Value

If Heures <> 0 Then 'On vérifie s'il y a équilibre de la ventilation des heures

sRep = MsgBox(" ! ATTENTION !" & Chr(10) & " Le total des heures nettes à ventiler sur l'activité directe doit être à zéro." & Chr(10) & _

"Vous avez vraisemblablement apporté des modifications sur vos objectifs. " & Chr(10) & _

"Le total des heures potentielles de l'entreprise est différent du nombre d'heures planifié." & Chr(10) & _

"Vous devez soit : " & Chr(10) & " - Modifier le nombre d'heures planifié" & Chr(10) & " - Ajuster l'effectif de l'entreprise par une embauche ou du personnel intérimaire." _

& Chr(10) & Chr(10) & "A cet instant le nombre d'heures à gérer est de :" & Chr(10) & Chr(10) & _

" " & Heures & " Heures" & Chr(10) & Chr(10) & "Cette boite de dialogue peut s'afficher tant que vous n'avez pas régulariser cette anomalie.", vbCritical + vbOKCancel + vbDefaultButton2, "Ventilation des heures potentiellement vendables")

If sRep = vbOK Then Sheets("Ventes").Activate

Range("R40").Select

End If

Rechercher des sujets similaires à "msgbox lorsque ont certaine couleur"