Re : Erreur 50290 la méthode intersect de l'objet global a échoué
Le code
Private Sub Worksheet_change(ByVal Target As Excel.Range)
Dim Colonne As Integer
Dim Adresse As String
Dim Rg As Range
Dim Rg2 As Range
Dim Rg3 As Range
Dim rngTrouve As Range
Dim strChaine As String
If Not Intersect(Target, Range("test2")) 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
27"), 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
27"), 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
27"), 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 *
''*****************************************
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