XL 2019 Test cellule avec Sub worksheet_change(ByVal target As Range)

pat66

XLDnaute Impliqué
Bonjour le forum,

je souhaiterai que si l'on saisit en A3 un chiffre supérieur C8, un msgbox s'affiche en m'indiquant le montant maxi saisissable de C8 et empêche de saisir une valeur supérieure

merci

j'ai essayé mais ce ne fonctionne pas :

Sub worksheet_change(ByVal target As Range)
Set Target = Range("A3")
If Target.Value > "C8" Then
MsgBox "la valeur de la cellule "C8" est atteinte"
end if
End Sub

ou alors lors de la selection de A3, un msgbox affiche le montant maxi qui est dans C8

merci pour votre aide
 
Dernière édition:
Solution
Bonjour,
Les 2 évènements (Prise en compte également d'une sélection et/ou saisie d'une plage incluant la cellule A3)
Bonne journée
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A3")) Is Nothing Then
    If [C8] <> "" And IsNumeric([C8]) Then
        If Range("A3").Value > [C8] Then
            MsgBox "          Cellule A3" & Chr(10) & "Valeur maximale permise : " & [C8], 48, "Annulation de saisie!"
            Range("A3").ClearContents
        End If
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A3")) Is Nothing Then
    If [C8] <> "" And IsNumeric([C8]) Then
        MsgBox "          Cellule A3" & Chr(10) & "Valeur maximale...

Cousinhub

XLDnaute Barbatruc
Inactif
Bonjour,
Les 2 évènements (Prise en compte également d'une sélection et/ou saisie d'une plage incluant la cellule A3)
Bonne journée
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A3")) Is Nothing Then
    If [C8] <> "" And IsNumeric([C8]) Then
        If Range("A3").Value > [C8] Then
            MsgBox "          Cellule A3" & Chr(10) & "Valeur maximale permise : " & [C8], 48, "Annulation de saisie!"
            Range("A3").ClearContents
        End If
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A3")) Is Nothing Then
    If [C8] <> "" And IsNumeric([C8]) Then
        MsgBox "          Cellule A3" & Chr(10) & "Valeur maximale permise : " & [C8], 48, "Limitation de valeur"
    End If
End If
End Sub
 

pat66

XLDnaute Impliqué
re,

tout fonctionne bien, mais je trouve que d'afficher 2 fois un msgbox d'avertissement, c'est un peu redondant,

est t'il possible de remplacer :

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A3")) Is Nothing Then
    If [C8] <> "" And IsNumeric([C8]) Then
        MsgBox "          Cellule A3" & Chr(10) & "Valeur maximale permise : " & [C8], 48, "Limitation de valeur"
    End If
End If
End Sub

par un commentaire ou une info bulle qui s'affiche au survol de A3, qui précise aussi la valeur maxi qui est en C8

merci beaucoup

pat66
 
Dernière édition:

Cousinhub

XLDnaute Barbatruc
Inactif
Re-,
En bas de ta feuille de calcul, à gauche, il y a un bouton qui sert à ouvrir l'enregistreur de macros..
Ce bouton est très utile, et à partir du moment où tu as appuyé dessus, tout ce que tu fais est enregistré.
Il suffit juste de ne pas oublier de ré-appuyer dessus pour stopper l'enregistrement, et ensuite d'aller voir le code généré.
Quelques ajustements plus tard, tu peux obtenir un truc dans le genre :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A3")) Is Nothing Then
    If Sheets("Feuil2").[C8] <> "" And IsNumeric(Sheets("Feuil2").[C8]) Then
        With Range("A3")
            .ClearComments
            .AddComment
        With .Comment
            .Visible = False
            .Text Text:="Valeur Maximale :" & Chr(10) & Sheets("Feuil2").[C8]
        End With
        End With
    End If
Else
    Range("A3").ClearComments
End If
End Sub
Bon courage
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Une autre proposition à mettre dans le module de l'objet Worksheet représentant la "Feuil2" :
Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Me.[C8], Target) Is Nothing Then Exit Sub
   With Sheets("Feuil1").[A3].Validation
      .Delete
      .Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, _
         Operator:=xlLessEqual, Formula1:="=Feuil2!C8"
      .IgnoreBlank = True: .InCellDropdown = True
      .InputTitle = "Valeur limite :"
      .InputMessage = Me.[C8].Value
      .ErrorTitle = "Valeur hors limite permise"
      .ErrorMessage = "Vous avez saisi en C3 une valeur > " & Me.[C8].Value
      .ShowInput = True
      .ShowError = True
      End With
   End Sub
 
Dernière édition:

pat66

XLDnaute Impliqué
re,

Un grand merci messieurs pour votre générosité et bravo pour vos compétences, c'est exactement ce qu'il me fallait, je vais insérer et adapter tout çà dans le classeur concerné

une très belle journée à vous

pat 66
 

pat66

XLDnaute Impliqué
Bonjour le fil,

après avoir réalisé plusieurs tests, je vous confirme que j'ai opté pour la solution de Bhbh ,car sous forme de commentaire, je peux personnaliser plus facilement l'apparence, taille police, forme, couleur, etc

Un grand merci à tous les deux et une belle journée

pat66
 

Discussions similaires

Réponses
1
Affichages
233

Statistiques des forums

Discussions
314 493
Messages
2 110 197
Membres
110 703
dernier inscrit
papysurf