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

pat66 · 5 Octobre 2022

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

Cousinhub · 5 Octobre 2022

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 · 5 Octobre 2022

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 · 5 Octobre 2022

bonjour,
ça fonctionne les deux solutions fonctionnent super bien, merci !!

je voudrais pas abuser, mais pouvez vous m'indiquer comment adapter la macro si la cellule C8 se trouve sur la feuil2

merci beaucoup !

pat66 · 5 Octobre 2022

re,

je crois que c'est bon, j'ai remplacé tous les [C8] par Sheets("Feuil2").[C8]) et ça à l'air de fonctionner

un grand merci et très belle journée

pat66

pat66 · 5 Octobre 2022

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

Cousinhub · 5 Octobre 2022

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 · 5 Octobre 2022

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

pat66 · 5 Octobre 2022

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 · 7 Octobre 2022

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

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

pat66

XLDnaute Impliqué

Cousinhub

Cousinhub

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

pat66

XLDnaute Impliqué

pat66

XLDnaute Impliqué

Cousinhub

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

pat66

XLDnaute Impliqué

pat66

XLDnaute Impliqué

Discussions similaires