Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3:H33")) Is Nothing Then
If Cells(36, Target.Column) > 10 Then
MsgBox "il y a plus de 10... !"
Application.Undo
End If
End If
End Sub
Un peu dure non ?stanwas06; fichier joint à dit:A la deuxième tentative, si cette valeur est dépassée, le fichier se ferme automatiquement en avertissant l'opérateur que ses données n'ont pas été sauvegardées
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Me.[B3:H33], Target) Is Nothing Then
If Me.Cells(36, Target.Column).Value >= 10 And Target.Value = "" Then
MsgBox "Choisissez une autre cellule"
Me.Cells(1, 1).Select
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellule As Range
For Each cellule In Range("B36:H36")
If cellule.Value > 10 Then
MsgBox ("Votre choix ne sera pas pris en compte")
Target.Value = ""
End If
Next cellule
End Sub
Private Sub Worksheet_Calculate()
With Worksheets("Feuil1").Range("B36:H36")
Set c = .Find(10, LookIn:=xlValues)
If Not c Is Nothing Then
MsgBox "Modifiez votre choix"
End If
End With
ActiveCell = ""
End Sub