Probleme code WorksheetChange

Version imprimable

18/08/2014, 18h05
MTIAEAIX

Probleme code WorksheetChange
Bonjour,

Je cherche à résoudre ce problème en vain et je suis sensée terminer ce fichier d'ici deux jours...
Je vous explique:

Mon fichier est un tableau excel dans lequel nous attribuons des notes à des fournisseurs sur des critères prédéfinis et qui génère des notes "finales" (moyenne de critères et note générale) selon des pondérations accordées aux critères notés.
Plusieurs personnes attribuent des notes à ces critères. Les évaluations portent sur des "segments" définis par des codes

J'ai mis en place deux macros qui doivent s'activer automatiquement lorsque les cellules concernées sont modifiées:

- une pour la saisie des informations fournisseurs: lorsque l'on saisit le code du segment l'intitulé apparait
- une seconde pour donner un message d'avertissement: lorsque la moyenne d'un critère est inférieure à 3 j'aimerai qu'un message alerte apparaisse.

Ma première macro fonctionne mais pas ma seconde et je n'arrive pas à les mettre ensemble.
Ma seconde macro: les cellules correspondantes aux moyennes des critères sont: R12, R24, R32, R44, R56, U12, U24, U32, U44, U56, W12, W24, W32, W44 et W56.
Ces cellules contiennent des formules SI qui ont permis le calcul des moyennes.
J'aimerai que lorsque l'une ou plusieurs de ces cellules affichent un résultat inférieur ou égal à 3 un message d'alerte apparaisse.

Je suis partie d'un worksheet change pour la deuxième macro mais cela bug: le message apparait qu'importe le résultat de la cellule ou apparait deux fois à la suite
j'avais essayé (exemple pour R12):
Code:

1 2 3 4 5 6 7 8 9 WORKSHEET CHANGE (ByVal Target As Range) Dim ValR12 As Range Set ValR12 = Range("R12") If ValR12 < 3 Then MsgBox "ALERTE" Exit Sub End If
cela semblait marcher, quand j'ai ajouté toutes les autres cellules cela ne fonctionnait plus...

Pour la première macro j'étais partie d'un WORKSHEET CALCULATE et ça fonctionne bien mais comment cumuler deux worksheet différets sur la même feuille?
Comment faire que mes deux macros agissent automatiquement et indépendamment l'une de l'autre?
Avez vous une proposition pour la seconde macro? (Avec explications je suis débutante?)

Je vous remercie pour votre aide

Cordialement,
18/08/2014, 18h39
Philippe Tulliez
Bonjour,
Le code que tu affiches n'est pas correct.
Une procédure commence toujours par Sub ou Function et une procédure événementielle a pour nom celui de l'objet suivi de l'événement. Tous les deux séparés par un Underscore
Exemple
Code:

1 2 3 Private Sub Worksheet_Change(ByVal Target As Range) MsgBox "Adresse " & Target.Value End Sub

Bonsoir Mtiaeaix, Philippe, bonsoir le forum,

Si les cellules contiennent des formules, je pense qu'il serait plus judicieux d'utiliser la macro événementielle Calculate. Peut-être comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Calculate()
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim MSG As String 'déclare la variable MSG (MeSsaGe)
 
'définit la plage PL
Set PL = Application.Union(Range("R12"), Range("R24"), Range("R32"), Range("R44"), Range("R56"), _
   Range("U12"), Range("U24"), Range("U32"), Range("U44"), Range("U56"), _
   Range("W12"), Range("W24"), Range("W32"), Range("W44"), Range("W56"))
 
For Each CEL In PL 'boucle sur toutes les cellule CEL de l aplage PL
    If CEL.Value < 3 Then 'condition : si la valeur de la cellule CEL est inférieure à 3
        'définit le message MSG
        MSG = IIf(MSG = "", "Alerte cellule : " & CEL.Address(0, 0), MSG & Chr(10) & "Alerte cellule : " & CEL.Address(0, 0))
    End If 'fin de la condition
Next CEL 'prochaine cellule de la boucle
MsgBox MSG 'affiche le message MSG
End Sub

Pour pas qu'il y ait d'interférence avec la première macro il faudrait que tu en fournisses le code...

18/08/2014, 19h14
MTIAEAIX

Re
Bien entendu qu'il y a private Sub et End Sub...
Je n'avais pas jugé utile de le noter car je me rendais compte que le problème venait de la conception de mes conditions...

J'avais essayé aussi avec Calculate selon mon modèle et ça ne fonctionnait pas j'étais tellement désespérée que j'avais abandonné le calculate!

Merci Tauthème demain matin je teste cette solution qui me parait correspondre PARFAITEMENT.
Une question supplémentaire à ce sujet: worksheet calculate fonctionne même si les calculs sont en automatique? (J'avais lu qu'il fallait cocher recalcule et décocher calcul automatique dans outils options!)

Pour ma première macro: J'ai 3 cellules B4, B5 et B6 dans lesquelles nous saisissons le code du segment
l'intitulé doit apparaitre dans les cellules C4, C5, C6

B4 est le code du premier segment et C4 son intitulé
B5 est le code du second segment (s'il y a, ce n'est pas obligatoire ça peut être vide) et C5 son intitulé
et idem B6

Je l'ai faite à partir de calculate
Code:

1 2 3 4 5 6 7 Dim ValB4 As Range ValB4 = Range("B4") If ValB4 = "CODE SEGMENT" Then "INTITULE" ElseIf ValB4 = "CODE SEGMENT" Then
jusqu'à épuisement de mes codes segments

puis le même avec B5 et le même avec B6

(Je pense que l'on eut faire avec Select Case)

Je vous remercie pour votre aide
18/08/2014, 20h27
Philippe Tulliez

Bonjour,

Citation:

Bien entendu qu'il y a private Sub et End Sub...
Je n'avais pas jugé utile de le noter car je me rendais compte que le problème venait de la conception de mes conditions...

A quoi bon prévoir des balises pour insérer son code si on commence à le retaper.
Déjà lorsque l'on tape des lignes de code, on a régulièrement des erreurs de syntaxes dû à de multiples raisons donc si tu veux avoir des réponses correctes par rapport à tes questions il est plus facile de faire un copier/coller de ta procédure que d'en retaper les lignes.
Enfin c'est mon avis.

je suis d'accord mais je ne suis pas sur mon poste de travail et je n'ai pas le copié collé à porter de mains.
Mais je commence déjà à tester les pistes que vous me donnez
Demain matin je vous enverrai le copié collé mais en dehors du private sub end sub le contenu était exactement ce que j'ai noté plus haut

Re bonjour,

J'ai tenté d'ajouter le code de tautheme mais cela ne fonctionne pas. En fait le message apparait peu importe si le critère est inférieur à 3 ou supérieur. Or j'aimerai que le message "Veuillez saisir une ligne évènement" n'apparaisse que lorsque l'un ou plusieurs des critères à une note inférieure à 3. De plus le message destiné aux modifications des cellules critères s'affiche même lors de modifications de mes cellules codes et intitulés.

Voici mes deux codes superposés (j'ai remplacé les intitulés par des lettres car le contenu est confidentiel.)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 
Private Sub Worksheet_Calculate()
 
Dim valB4, valB5, valB6, valC4, valC5, valC6 As Range
 
    valB4 = Range("B4")
    valB5 = Range("B5")
    valB6 = Range("B6")
    valC4 = Range("C4")
    valC5 = Range("C5")
    valC6 = Range("C6")
 
 
If Range("B4") <> valB4 Then
valB4 = Range("B4")
 
    If Range("B4") = "1BCDFR" Then
    Range("C4") = "FFFFFFF"
 
    ElseIf Range("B4") = "1CCDRE" Then
    Range("C4") = "FFFFFFFE"
 
    ElseIf Range("B4") = "1DCDRF" Then
    Range("C4") = "MMMMMM"
 
    ElseIf Range("B4") = "1ETRGF" Then
    Range("C4") = "CCCCCCC"
 
    ElseIf Range("B4") = "1FTYHG" Then
    Range("C4") = "NNNNNNN"
 
End If
 
End If
 
If Range("B5") <> valB5 Then
valB5 = Range("B5")
 
    If Range("B5") = "1BCDFR" Then
    Range("C5") = "FFFFFFF"
 
    ElseIf Range("B5") = "1CCDRE" Then
    Range("C5") = "FFFFFFFE"
 
    ElseIf Range("B5") = "1DCDRF" Then
    Range("C5") = "MMMMMM"
 
    ElseIf Range("B5") = "1ETRGF" Then
    Range("C5") = "CCCCCCC"
 
    ElseIf Range("B5") = "1FTYHG" Then
    Range("C5") = "NNNNNNN"
End If
 
End If
 
If Range("B6") <> valB6 Then
valB64 = Range("B6")
 
    If Range("B6") = "1BCDFR" Then
    Range("C6") = "FFFFFFF"
 
    ElseIf Range("B6") = "1CCDRE" Then
    Range("C6") = "FFFFFFFE"
 
    ElseIf Range("B6") = "1DCDRF" Then
    Range("C6") = "MMMMMM"
 
    ElseIf Range("B6") = "1ETRGF" Then
    Range("C6") = "CCCCCCC"
 
    ElseIf Range("B6") = "1FTYHG" Then
    Range("C6") = "NNNNNNN"
End If
 
End If
 
Dim PL As Range
Dim CEL As Range
Dim MSG As String
 
Set PL = Application.Union(Range("R12"), Range("R24"), Range("R32"), Range("R44"), Range("R56"), _
   Range("U12"), Range("U24"), Range("U32"), Range("U44"), Range("U56"), _
   Range("W12"), Range("W24"), Range("W32"), Range("W44"), Range("W56"))
 
For Each CEL In PL
If CEL.Value < 3 Then
 MSG = IIf(MSG = "", "Alerte cellule : " & CEL.Address(0, 0), MSG & Chr(10) & "Alerte cellule : " & CEL.Address(0, 0))
End If
Next CEL
MsgBox "Veuillez saisir une ligne évènement"
 
End Sub

Si vous pouviez m'aider ce serait top!!!

Merci encore

bonjour le fil, bonjour le forum,

Je ne comprends pas où tu veux en venir et sans fichier exemple impossible de tester. Déjà la déclaration de tes variable n'est pas correcte. Seule la variable ValC6b sera de type Range les autres prennent pas défaut le type Variant. Tu peux déclarer plusieurs variables dans la même ligne mais tu dois impérativement en spécifier le type pour chacune d'entre elles :

Code:

Dim valB4 As Range, valB5 As Range, valB6 As Range, valC4 As Range, valC5 As Range, valC6 As Range

Ensuite tu écris :

Code:

valB4 = Range("B4")

Si c'est une variable de type Range il faut écrire :

Code:

Set valB4 = Range("B4")

Mais ce n'est pas bien grave car tu continues par :

Code:

If Range("B4") <> valB4 Then valB4 = Range("B4")

Je vois mal comment Range("B4") pourrait être différent de ValB4 puisque ValB4 vaut Range("B4")... Bref c'est très confus et ça ne m'étonne absolument pas que ce code ne fonctionne pas correctement.
Dans ton Post #1 tu parlais d'éditer les code segments donc, pour moi, cette partie là na rien à faire dans l'événement Calculate.

Voilà comment je verrais les chose (si j'ai compris, ce qui m'étonnerait...)
D'abord la macro événementielle Change pour gérer les codes et l'intitulé :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet If Application.Intersect(Target, Range("B4:B6")) Is Nothing Then Exit Sub 'si le changement a lieu ailleurs que dans la plage B4:B6, sort de la procédure Select Case Target.Value 'agit en fonction de la valeur de la cellule éditée Case "1BCDFR" 'cas "1BCDFR" Target.Offset(0, 1).Value = "FFFFFFF" 'modifie la cellue adjacente en colonne C Case "1CCDRE" 'cas "1CCDRE" Target.Offset(0, 1).Value = "FFFFFFFE" 'modifie la cellue adjacente en colonne C Case "1DCDRF" 'cas "1DCDRF" Target.Offset(0, 1).Value = "MMMMMM" 'modifie la cellue adjacente en colonne C Case "1ETRGF" 'cas "1ETRGF" Target.Offset(0, 1).Value = "CCCCCCC" 'modifie la cellue adjacente en colonne C Case "1FTYHG" 'cas "1FTYHG" Target.Offset(0, 1).Value = "NNNNNNN" 'modifie la cellue adjacente en colonne C End Select 'fin de l'action en fonction de la valeur de la cellule éditée End Sub
Ensuite la macro évenementielle Calculate pour les moyennes avec critères :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub Worksheet_Calculate() Dim PL As Range 'déclare la variable PL (PLage) Dim CEL As Range 'déclare la variable CEL (CELlule) 'définit la plage PL Set PL = Application.Union(Range("R12"), Range("R24"), Range("R32"), Range("R44"), Range("R56"), _ Range("U12"), Range("U24"), Range("U32"), Range("U44"), Range("U56"), _ Range("W12"), Range("W24"), Range("W32"), Range("W44"), Range("W56")) For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL If CEL.Value < 3 Then 'condition : si la valeur de la cellue est inférieure à 3 MsgBox "Veuillez saisir une ligne évènement" 'message CEL.Select 'sélectionne la cellule Exit Sub 'sort de la procédure Next CEL 'prochaine cellule de la plage End Sub
Pour finir, si ce code ne fonctionne pas comme tu le désires, met un fichier exemple en pièce jointe car sans lui je ne comprends pas...

19/08/2014, 11h44
MTIAEAIX

1 pièce(s) jointe(s)

Bonjour Thauthème,

Je te remercie pour le code qui me semble juste.
D'ailleurs pour la première macro je l'avais écrite de la sorte au départ mais ça ne fonctionnait et ne fonctionne toujours pas :(

Je t'ai mis en pj le fichier: il est en tout point identique à mon fichier, j'ai simplement enlever le contenu de toutes les cellules sauf: les listes déroulantes, les formules de calcul et j'ai nommé les critères V1, V2, V3, V4, V5. Les cellules R12, R24, R32, R44, R56, U12, U24, U32, U44, U56, W12, W24, W32, W44, W56 correspondent aux moyennes des critères. Il y a une moyenne par critère et par code (3 codes possibles, 1 obligatoire et 5 critères)

Ta macro ne donne pas le résultat attendu:

Lors que je saisie en B4 le code en C4 l'intitulé apparait bien mais la fenêtre "veuillez saisir etc" apparait également alors qu'elle ne devrait apparaître que lors d'un changement d enote critère et quand cette note est inférieure à 3
Par ailleurs même lorsque la note est supérieure à 3 la fenêtre apparait, j'aimerai que quand c'est supérieure à 3 il n'apparaisse rien.

Je te remercie pour ta réponse et pour prendre le temps de m'aider

Je précise mon souhait: si par exemple la note en R12 est supérieure à 3 et la note en R24 est inférieure à 3 et que je modifie une cellule en I12 ou N12 qui vont modifier R12 mais le résultat reste supérieur à 3 je ne souhaite pas que le message apparaisse

je souhaite que ce message intervienne séparément pour chacune des moyennes de critère.
Donc pour R12 à chaque fois que le résultat R12 est modifié si < 3 message sinon rien
Pour R24 de façon indépendante si résultat R24 modifié inférieur à 3 message sinon rien

J'espère que le fichier et mes explications sont claires et vous remercie encore une fois
19/08/2014, 11h59
Thautheme

Bonjour le fil, bonjour le forum,

Je comprends mieux avec le fichier. Cellules fusionnées = gros m..dier ! Je vais essayer de trouver un solution. quand j'aurais du temps...
19/08/2014, 13h07
MTIAEAIX

RE

Merci Thautheme tu es mon dernier espoir!

Mais tu vois j'avais plus l'impression qu'on oublie quelquechose dans la façon de poser les conditions.
Car la macro s'active bien seulement tant qu'un des critères est inférieur à 3 un message apparait et non pas indépendamment pour chaque critère...
Je ne sais pas trop quoi présenter du coup...

Bonjour le fil, bonjour le forum,

Avec le fichier je revoie mes propositions antérieures et je te propose tout dans la macro événementielle Change ci-dessous :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
 
If Not Application.Intersect(Target, Range("I12:I23")) Is Nothing Then
    If Cells(12, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(12, 18).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("K12:K23")) Is Nothing Then
    If Cells(12, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(12, 21)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("M12:M23")) Is Nothing Then
    If Cells(12, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(12, 23)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("H24:I31")) Is Nothing Then
    If Cells(24, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(24, 18)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("J24:K31")) Is Nothing Then
    If Cells(24, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(24, 21)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("L24:M31")) Is Nothing Then
    If Cells(24, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(24, 23)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("H32:I43")) Is Nothing Then
    If Cells(32, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(32, 18)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("J32:K43")) Is Nothing Then
    If Cells(32, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(32, 21)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("L32:M43")) Is Nothing Then
    If Cells(32, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(32, 23)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("H44:I55")) Is Nothing Then
    If Cells(44, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(44, 18)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("J44:K55")) Is Nothing Then
    If Cells(44, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(44, 21)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("L44:M55")) Is Nothing Then
    If Cells(44, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(44, 23)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("H56:I91")) Is Nothing Then
    If Cells(56, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(56, 18)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("J56:K91")) Is Nothing Then
    If Cells(56, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(56, 21)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("L56:M61")) Is Nothing Then
    If Cells(56, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(56, 23)(1).Select: Exit Sub
End If
 
If Application.Intersect(Target, Range("B4:B6")) Is Nothing Then Exit Sub 'si le changement a lieu ailleurs que dans la plage B4:B6, sort de la procédure
Select Case Target.Value 'agit en fonction de la valeur de la cellule éditée
    Case "1BCDFR" 'cas "1BCDFR"
        Target.Offset(0, 1).Value = "FFFFFFF" 'modifie la cellue adjacente en colonne C
    Case "1CCDRE" 'cas "1CCDRE"
        Target.Offset(0, 1).Value = "FFFFFFFE" 'modifie la cellue adjacente en colonne C
    Case "1DCDRF" 'cas "1DCDRF"
        Target.Offset(0, 1).Value = "MMMMMM" 'modifie la cellue adjacente en colonne C
    Case "1ETRGF" 'cas "1ETRGF"
        Target.Offset(0, 1).Value = "CCCCCCC" 'modifie la cellue adjacente en colonne C
    Case "1FTYHG" 'cas "1FTYHG"
        Target.Offset(0, 1).Value = "NNNNNNN" 'modifie la cellue adjacente en colonne C
End Select 'fin de l'action en fonction de la valeur de la cellule éditée
End Sub

19/08/2014, 16h02
MTIAEAIX

GENIAL

BRAVO THAUTHEM!!!!

tu es GENIAL (just in time en plus!!!!!)

je te sollicite une dernière fois pour un avis (car tu es un dieu VBA)

- est ce qu'il m'est possible sur ce type de fichier de: demander aux évaluateurs de s'identifier, selon l'évaluateur ne pas afficher toutes les cellules? (afficher par exemple tout afficher pour l'acteur 1 sauf les cellules spécifiques Acteur 2, acteur 3, acteur 4?)
l'évaluateur ouvrirait le fichier se retrouverait face à un menu déroulant qui contiendrait les fonctions possibles des évaluateurs (par exemple directeur qualité, directeur financier etc) et selon le choix doit entrer un mot de passe pour accéder à la fiche et selon le choix que certaines cellules sur la fiche ne s'affichent pas?
comment cela s'organiserait il?

MERCI MERCI MERCI
19/08/2014, 16h39
Thautheme

Bonjour le fil, bonjour le forum,

Bon, d'abord il faut arrêter les compliments car après je prends du melon et je ne peux plus mettre le chapeau mexicain que ma cousine m'a ramené de d'Andalousie et qui me sied à merveille tellement il est discret...
Ensuite, ce que tu demandes doit être facilement réalisable mais je n'ai pas trop le temps. Il faudrait que tu fasses une recherche dans le forum car il doit y avoir des exemples déjà fait. De mon coté j'essaie mais vraiment je ne te garantie rien...
19/08/2014, 16h43
MTIAEAIX

:DDDD

Tu viens de me sauver la vie donc COMPLIMENTS OBLIGES!
Tan pis pour le chapeau mexicain!!!

J'ai déjà des pistes, je pense même faire plus simple et mettre en place un système de mot de passe dans Workbook Open.
Si jamais tu as des suggestions je suis tout de même preneuse Ô maitre VBA!!!!
20/08/2014, 12h04
Thautheme

1 pièce(s) jointe(s)

Bonjour le fil, bonjour le forum,

En pièce jointe une proposition...
la procédure :
• D'abord, ouvre le fichier sans activer les macros.
• Va dans l'onglet Données et imprime-le.
• Par VBE (Visual Basic Editor) masque l'onglet Données par la propriété [Visible] = 2 xlSheetVeryHidden
• Sauve le fichier
• Ferme-le...

Maintenant tu testes avec les Évaluateurs et le codes que tu as imprimés...

Par la suite tu referas la procédure, tu afficheras l'onglet Données, tu éditeras tes propres nom, code et accès...

Au niveau de l'accès je n'ai rien verrouillé, j'ai juste masqué les colonnes, tu adapteras/modifieras le code...
J'ai laissé l'onglet Interface vierge pour te permettre de le mettre en forme à ton goût avec éventuellement des photos, dessins ou logos. Il est là juste pour éviter d'entrer directement dans l'onglet de travail...
Ce code (même si tu verrouilles) est extrêmement simple à faire sauter par un utilisateur averti. N'y vois pas une garantie totale d'autorisation d'accès...
Le fichier :
21/08/2014, 00h05
MTIAEAIX

THAUTHEME HELP!!!

Bonsoir Thauthem,

Je m'atèle demain à tester tes propositions,

J'ai de nouveau un souci avec la macro pour afficher un message lors d'un critère inférieur à 3...
Je m'explique : pour le critère 1 du segment 1 en R12 il faut que la macro s'active si il y a modif dans les cellules I12 à I23 mais aussi dans les cellules N12 a N23 et O12 à O23...Il y a trois plages
et c'est le même principe selon les segments et critères: il faut qu'à chaque fois qu'un évaluateur modifie sa note et que du coup la note du critère est inférieure à 3 le msg apparaisse (pour savoir quelles sont les plages à remplir: grisées les cellules que les évaluateurs ne doivent pas remplir, une couleur par segment vert clair = 1er segment et deux évaluateurs qui n'évaluent pas tous les critères, vert foncé second segment et idem, orange 3ème segment et idem, en bleu 3 évaluateurs dont les notes entrent en compte dans les moyennes des 3 segments ils n'évaluent pas tous les critères)

Pourrais tu me reproposer ton code? Car lorsque je le modifie cela ne fonctionne pas...

Par ailleurs si un critère affiche NA alors la macro ne doit pas s'activer

MERCI ENCORE

1 pièce(s) jointe(s)

Bonjour le fil, bonjour le forum,

J'ai repassé les cellules une par une en faisant Repérér les antécédents et Repérér les dépendants et voilà le code modifié :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
 
If Not Application.Intersect(Target, Application.Union(Range("I12:I23"), Range("N12:O23"))) Is Nothing Then
    If Cells(12, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(12, 18).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("K12:K23")) Is Nothing Then
    If Cells(12, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(12, 21)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("M12:O23")) Is Nothing Then
    If Cells(12, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(12, 23)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("H24:I31")) Is Nothing Then
    If Cells(24, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(24, 18)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("J24:K31")) Is Nothing Then
    If Cells(24, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(24, 21)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("L24:M31")) Is Nothing Then
    If Cells(24, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(24, 23)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Application.Union(Range("H32:I43"), Range("N32:N43"))) Is Nothing Then
    If Cells(32, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(32, 18)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Application.Union(Range("J32:K43"), Range("N32:N43"))) Is Nothing Then
    If Cells(32, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(32, 21)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("L32:N43")) Is Nothing Then
    If Cells(32, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(32, 23)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Application.Union(Range("H44:I55"), Range("N44:O55"))) Is Nothing Then
    If Cells(44, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(44, 18)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Application.Union(Range("J44:K55"), Range("N44:O55"))) Is Nothing Then
    If Cells(44, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(44, 21)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("L44:O55")) Is Nothing Then
    If Cells(44, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(44, 23)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Application.Union(Range("H56:I91"), Range("N56:P91"))) Is Nothing Then
    If Cells(56, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(56, 18)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Application.Union(Range("J56:K91"), Range("N56:P91"))) Is Nothing Then
    If Cells(56, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(56, 21)(1).Select: Exit Sub
End If
If Not Application.Intersect(Target, Range("L56:P61")) Is Nothing Then
    If Cells(56, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(56, 23)(1).Select: Exit Sub
End If
If Application.Intersect(Target, Range("B4:B6")) Is Nothing Then Exit Sub 'si le changement a lieu ailleurs que dans la plage B4:B6, sort de la procédure
Select Case Target.Value 'agit en fonction de la valeur de la cellule éditée
    Case "1BCDFR" 'cas "1BCDFR"
        Target.Offset(0, 1).Value = "FFFFFFF" 'modifie la cellue adjacente en colonne C
    Case "1CCDRE" 'cas "1CCDRE"
        Target.Offset(0, 1).Value = "FFFFFFFE" 'modifie la cellue adjacente en colonne C
    Case "1DCDRF" 'cas "1DCDRF"
        Target.Offset(0, 1).Value = "MMMMMM" 'modifie la cellue adjacente en colonne C
    Case "1ETRGF" 'cas "1ETRGF"
        Target.Offset(0, 1).Value = "CCCCCCC" 'modifie la cellue adjacente en colonne C
    Case "1FTYHG" 'cas "1FTYHG"
        Target.Offset(0, 1).Value = "NNNNNNN" 'modifie la cellue adjacente en colonne C
End Select 'fin de l'action en fonction de la valeur de la cellule éditée
End Sub

Bonjour le fil, bonjour le forum,

Le code avec la gestion des NA...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim PL As Range
Dim CEL As Range
Dim T As Boolean
 
Set PL = Application.Union(Range("I12:I23"), Range("N12:O23"))
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(12, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(12, 18).Select: Exit Sub
    T = False
End If
 
Set PL = Range("K12:K23")
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(12, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(12, 21)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Range("M12:O23")
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(12, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(12, 23)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Range("H24:I31")
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(24, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(24, 18)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Range("J24:K31")
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(24, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(24, 21)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Range("L24:M31")
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(24, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(24, 23)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Union(Range("H32:I43"), Range("N32:N43"))
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(32, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(32, 18)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Application.Union(Range("J32:K43"), Range("N32:N43"))
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(32, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(32, 21)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Range("L32:N43")
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(32, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(32, 23)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Application.Union(Range("H44:I55"), Range("N44:O55"))
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(44, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(44, 18)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Application.Union(Range("J44:K55"), Range("N44:O55"))
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(44, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(44, 21)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Range("L44:O55")
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(44, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(44, 23)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Application.Union(Range("H56:I91"), Range("N56:P91"))
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(56, 18)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(56, 18)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Application.Union(Range("J56:K91"), Range("N56:P91"))
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(56, 21)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(56, 21)(1).Select: Exit Sub
    T = False
End If
 
Set PL = Range("L56:P61")
If Not Application.Intersect(Target, PL) Is Nothing Then
    For Each CEL In PL
        If CEL(1).Value = "NA" Then T = True: Exit For
    Next CEL
    If T = False And Cells(56, 23)(1).Value < 3 Then MsgBox "Veuillez saisir une ligne évènement": Cells(56, 23)(1).Select: Exit Sub
    T = False
End If
 
If Application.Intersect(Target, Range("B4:B6")) Is Nothing Then Exit Sub 'si le changement a lieu ailleurs que dans la plage B4:B6, sort de la procédure
Select Case Target.Value 'agit en fonction de la valeur de la cellule éditée
    Case "1BCDFR" 'cas "1BCDFR"
        Target.Offset(0, 1).Value = "FFFFFFF" 'modifie la cellue adjacente en colonne C
    Case "1CCDRE" 'cas "1CCDRE"
        Target.Offset(0, 1).Value = "FFFFFFFE" 'modifie la cellue adjacente en colonne C
    Case "1DCDRF" 'cas "1DCDRF"
        Target.Offset(0, 1).Value = "MMMMMM" 'modifie la cellue adjacente en colonne C
    Case "1ETRGF" 'cas "1ETRGF"
        Target.Offset(0, 1).Value = "CCCCCCC" 'modifie la cellue adjacente en colonne C
    Case "1FTYHG" 'cas "1FTYHG"
        Target.Offset(0, 1).Value = "NNNNNNN" 'modifie la cellue adjacente en colonne C
End Select 'fin de l'action en fonction de la valeur de la cellule éditée
End Sub