Worksheet_change et liste de validation

**gr12sable** · 10/01/2011, 17h45

Bonjour à tous,

Je suis entrain de créer un tableau d'affectation de personnne à des machines avec les régles de bases suivantes :
PAs de de personnes sur 2 machines différentes
Seul les personnes de la liste peuvent être utilisé
Possibilité de saisir les personnes ou de les choisir via liste de validations

Hors c'est sur ce point que ca bloque, j'ai la maccro suivante qui plante methode interesect global lorsque je saisie les première lettre du nom à choisir puis utilise la liste de validation.
Un exemple est toujours plus clair

Je tape "toto", ma maccro le met en majuscule et verifie si présent ou pas de doublons ==> pas de pb
"TOTO" déjà utilise me le signale et supprime le doublon ==> pas de pb
Je saisi "to" puis veut utiliser la liste de validation et la maccro me jette ...

Des idées ?? J'ai l'impression que mon code n'est pas compatible avec les liste de validation. Que pourrai-je utiliser? Merci de votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub Worksheet_change(ByVal Target As Excel.Range)
 
Dim Colonne As Integer
Dim Adresse As String
Dim isect As Range
Dim Rg As Range
Dim Rg2 As Range
Dim Rg3 As Range
Dim rngTrouve As Range
Dim strChaine As String
 
If Target.Count > 1 Then Exit Sub
 
If Not Application.Intersect([test], Target) Is Nothing Then 'surveiller modif que sur zone définie
 
If Len(Target.Value) <> "" Then
 
'*************************
'* Ecriture en majuscule *
'*************************
 
Set Rg = Application.Intersect(Target, Columns(2))
If Not Rg Is Nothing Then
    Application.EnableEvents = False
        For Each c In Rg
        c.Value = UCase(c)
        Next
    Application.EnableEvents = True
End If
 
 
Set Rg2 = Application.Intersect(Target, Columns(3))
If Not Rg2 Is Nothing Then
    Application.EnableEvents = False
        For Each c In Rg2
        c.Value = UCase(c)
        Next
    Application.EnableEvents = True
End If
 
 
Set Rg3 = Application.Intersect(Target, Columns(4))
If Not Rg3 Is Nothing Then
    Application.EnableEvents = False
        For Each c In Rg3
        c.Value = UCase(c)
        Next
    Application.EnableEvents = True
End If
 
'**********************
'* Recherche doublons *
'**********************
 
If Target.Column = 2 Then
    If Application.WorksheetFunction.CountIf(Range("B4:D255"), Target.Value) > 1 Then
    Adresse = Columns(2).Find(what:=Target.Value, After:=Target.Offset(1, 0), lookat:=xlWhole, _
    SearchDirection:=xlNext).Address
        If MsgBox("L'opérateur ' " & Target & " ' est déjà occupé sur un autre poste de charge." & Chr(10) & "Utilisation en " & Adresse & Chr(10) & Chr(10) & " Le supprimer ?", vbYesNo + vbCritical, "Doublons") = vbYes Then
        Target.Value = ""
        Else
        MsgBox "Doublon conservé", vbExclamation
        End If
    End If
End If
 
 
If Target.Column = 3 Then
    If Application.WorksheetFunction.CountIf(Range("B4:D255"), Target.Value) > 1 Then
    Adresse = Columns(3).Find(what:=Target.Value, After:=Target.Offset(1, 0), lookat:=xlWhole, _
    SearchDirection:=xlNext).Address
        If MsgBox("L'opérateur ' " & Target & " ' est déjà occupé sur un autre poste de charge." & Chr(10) & "Utilisation en " & Adresse & Chr(10) & Chr(10) & " Le supprimer ?", vbYesNo + vbCritical, "Doublons") = vbYes Then
        Target.Value = ""
        Else
        MsgBox "Doublon conservé", vbExclamation
        End If
    End If
 
End If
 
If Target.Column = 4 Then
    If Application.WorksheetFunction.CountIf(Range("B4:D255"), Target.Value) > 1 Then
    Adresse = Columns(4).Find(what:=Target.Value, After:=Target.Offset(1, 0), lookat:=xlWhole, _
    SearchDirection:=xlNext).Address
        If MsgBox("L'opérateur ' " & Target & " ' est déjà occupé sur un autre poste de charge." & Chr(10) & "Utilisation en " & Adresse & Chr(10) & Chr(10) & " Le supprimer ?", vbYesNo + vbCritical, "Doublons") = vbYes Then
        Target.Value = ""
        Else
        MsgBox "Doublon conservé", vbExclamation
        End If
    End If
End If
 
''*****************************************
''* Recherche valeur existante dans liste *
''*****************************************
 
'lookat et whole = recherche correspondance exacte
strChaine = Target.Value
Set rngTrouve = Sheets("Liste").Columns(1).Cells.Find(what:=strChaine, lookat:=xlWhole)
 
    If rngTrouve Is Nothing Then
    MsgBox "Opérateur non enregistré", vbCritical, "Choix Impossible"
    Target.Value = ""
    End If
 
 
 
End If
 
End If
 
End Sub

**mercatog** · 10/01/2011, 21h26

Bonsoir
Teste ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Worksheet_change(ByVal Target As Excel.Range)
Dim rngTrouve As Range
Dim Adresse As String
 
Application.ScreenUpdating = False
If Target.Count = 1 Then
   If Not Application.Intersect([test], Target) Is Nothing Then   'surveiller modif que sur zone définie
      If Len(Target.Value) <> "" Then
         Select Case Target.Column
            Case 2 To 4
               On Error GoTo Erreur
               Application.EnableEvents = False
               Target.Value = UCase(Target.Value)
               If Application.CountIf(Range("B:D"), Target.Value) > 1 Then
                  Adresse = Columns(Target.Column).Find(Target.Value, lookat:=xlWhole).Address
                  If MsgBox("L'opérateur ' " & Target.Value & " ' est déjà occupé sur un autre poste de charge." & vbCrLf & "Utilisation en " & Adresse & vbCrLf & vbCrLf & " Le supprimer ?", vbYesNo + vbCritical, "Doublons") = vbYes Then
                     Target.ClearContents
                  Else
                     MsgBox "Doublon conservé", vbExclamation
                  End If
               Else
                  Set rngTrouve = Sheets("Liste").Range("A:A").Find(Target.Value, lookat:=xlWhole)
                  If rngTrouve Is Nothing Then
                     MsgBox "Opérateur non enregistré", vbCritical, "Choix Impossible"
                     Target.ClearContents
                  Else
                     Set rngTrouve = Nothing
                  End If
               End If
Erreur:
               Application.EnableEvents = True
         End Select
      End If
   End If
End If
End Sub

**gr12sable** · 11/01/2011, 09h35

Merci de la proposition, malheureusement ca ne fonctionne toujours pas...

Erreur '50290'
la méthode screenupdating de l'objet _Application a échoué

Ou si je met en commentaire la ligne

Erreur '50290'
La méthode _Evaluate de l'objet Worksheet a échoué ....

**mercatog** · 11/01/2011, 11h23

Pourtant c'est Ton code résumé
au lieu de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

   If Not Application.Intersect([test], Target) Is Nothing Then

fais un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

   If Not Application.Intersect(Range("B:D"), Target) Is Nothing Then

Pour la première erreur, je n'ai aucune idée, c'était pour inhiber la rafraichissement écran.

**gr12sable** · 11/01/2011, 16h41

Pareil ...

Ca doit venir des formules de mes liste de validations c'est pas possibles autrement ... Pourtant elle fonctionne correctement avant que la maccro ...

**mercatog** · 11/01/2011, 17h06

joindre un extrait de ton fichier

Worksheet_change et liste de validation

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager