J'aimerai remplacer .value < 35 par une formule de type .formula = "i10*0.7"
sachant que ma cellule i10 est fusionnée avec i11
et répéter cette opération de la cellule D19 à D48
If Target.Address = Range("d19").Address And Range("d19").Value < 35 Then
Voici le code VBA sans effacement de la valeur erronée (hors tolérance) :
VB:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .CountLarge > 1 Then Exit Sub
If .Column <> 4 Then Exit Sub
Dim lig&: lig = .Row
If lig < 19 Or lig > 48 Then Exit Sub
If lig = 23 Or lig = 44 Then Exit Sub
If .Value >= Round([I10] * 0.7, 0) Then Exit Sub
Dim i As Byte
For i = 1 To 3 'Loop 3 times.
Beep
'PlaySound ThisWorkbook.Path & "\0257", 0, 1
Next i
MsgBox "Attention valeur hors tolérance"
End With
End Sub
et voici le code VBA avec effacement de la valeur hors tolérance :
Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)...
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .CountLarge > 1 Then Exit Sub
If Intersect(Target, [D19:D48]) Is Nothing Then Exit Sub
Application.EnableEvents = 0
If .Value < 35 Then .Value = [I10] * 0.7
Application.EnableEvents = -1
End With
End Sub
Par contre la valeur 35 était un exemple car la cellule I10 va varier en fonction du produit.
Je te mets ma macro ci-dessous :
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo line
If Target.Address = Range("d19").Address And Range("d19").Value < 35 Then
'If Target.Address = Range("d19").MergeArea.Address And Range("d19").Value < 35 Then
Dim I
For I = 1 To 3 ' Loop 3 times.
Beep
'PlaySound ThisWorkbook.Path & "\0257", 0, 1
MsgBox "Attention valeur hors tolérance"
Next I
End If
attention : ton Exit Sub juste avant le End Sub ne sert à rien,
puisque même sans, on sort aussitôt de la sub !
J'ai réécrit ta sub ainsi (avec une ou deux autres modifs) :
VB:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo Fin
If Target.Address(0, 0) = "D19" And [D19] < 35 Then
'If Target.Address(0, 0) = [D19].MergeArea.Address And [D19] < 35 Then
Dim I As Byte
For I = 1 To 3 'Loop 3 times.
Beep
'PlaySound ThisWorkbook.Path & "\0257", 0, 1
MsgBox "Attention valeur hors tolérance"
Next I
End If
Fin:
End Sub
attention : ton Exit Sub juste avant le End Sub ne sert à rien,
puisque même sans, on sort aussitôt de la sub !
J'ai réécrit ta sub ainsi (avec une ou deux autres modifs) :
VB:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo Fin
If Target.Address(0, 0) = "D19" And [D19] < 35 Then
'If Target.Address(0, 0) = [D19].MergeArea.Address And [D19] < 35 Then
Dim I As Byte
For I = 1 To 3 'Loop 3 times.
Beep
'PlaySound ThisWorkbook.Path & "\0257", 0, 1
MsgBox "Attention valeur hors tolérance"
Next I
End If
Fin:
End Sub
attention : ton Exit Sub juste avant le End Sub ne sert à rien,
puisque même sans, on sort aussitôt de la sub !
J'ai réécrit ta sub ainsi (avec une ou deux autres modifs) :
VB:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo Fin
If Target.Address(0, 0) = "D19" And [D19] < 35 Then
'If Target.Address(0, 0) = [D19].MergeArea.Address And [D19] < 35 Then
Dim I As Byte
For I = 1 To 3 'Loop 3 times.
Beep
'PlaySound ThisWorkbook.Path & "\0257", 0, 1
MsgBox "Attention valeur hors tolérance"
Next I
End If
Fin:
End Sub
Comme je m'explique très mal, je te mets mon fichier pour que tu vois qu'en i10 la valeur varie et donc je dois mettre une formule du type : D19 = i10*0,7 et cela répétable [D19:H48]
Ton fichier en retour ; fais tous les essais nécessaires, puis regarde le code VBA. Attention : lis très attentivement tous les commentaires que j'y ai mis (en vert) !
Si tu as besoin d'une adaptation, dis-le moi ; à te lire pour avoir ton avis.
La plage [D19:E22;D24:E43;D45:E48] ne doit pas se remplir automatiquement car c'est une personne qui doit mettre les valeurs qu'elle trouve.
Le principe est d'afficher un message d'erreur si la valeur saisie est < à la valeur de la cellule i10*0.7
Exemple je saisie 50 dans i10 et si je rentre la valeur 34 dans D19, mon beep se déclenche avec la msgbox (car 50*0.7 = 35 et si D19 = 34 alors 34 < 35).
La cellule i10 peut avoir n'importe quelle valeur, la seule chose qui est tjrs vrai c'est "beep + msgbox" quand [D19:E22;D24:E43;D45:E48] < i10*0.7
Pour tous tes commentaires je vais regarder ça à tête reposée et bien me concentrer car je débute en VBA ^^.
Désolé, j'avais mal compris ton exo ; je vais le refaire, à partir de tes nouvelles infos.
En attendant, essaye juste ce petit code VBA :
VB:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim n&
With Target
n = .CountLarge: If n > 2 Then Exit Sub
If .Column <> 4 Then Exit Sub
MsgBox n & " " & .Address(0, 0) & " " & .Column
End With
End Sub
* la cellule D19 étant vide, saisis 100 en D19 ➯ msessage : 1 D19 4
même si c'est une fusion D:E, ça compte pour 1 seule cellule,
l'adresse de Target est D19, et la colonne de Target est D.
* touche Suppr pour supprimer D19 ➯ message : 2 D19:E19 4
le nombre de cellules sélectionnées est 2, car Target est la fusion D19:E19,
ce qui est bien indiqué par le .Address(0,0) du Target ; sa colonne est
toujours D, même si l'adresse est de 2 cellules.
* avec ce qui est décrit ci-dessus, ça explique : If n > 2 Then Exit Sub
on continue en dessous uniquement pour les valeurs 1 et 2, sinon on sort
de la sub si c'est 3 ou plus.
* avec ce code VBA, je suis sûr que c'est une cellule de la colonne D (ou de la fusion D:E) qui est modifiée ; l'étape suivante va être de
contrôler le n° de ligne, pour que seules les lignes de saisie pour
l'Epaisseur mini soient prises en compte.
Tu as écrit : « la valeur saisie dans la cellule disparaît après tabulation »
oui, je le sais bien, lollllll ! j'ai voulu t'en laisser la surprise ; voici l'explication :
tu saisis 34 ; puis comme 34 < 50, le message "hors tolérance" s'affiche ; alors j'ai pensé
que tu aurais aimé qu'on efface la mauvaise valeur automatiquement ➯ ça revient à
l'état avant la saisie erronée, donc la cellule est de nouveau vide (sans que tu aies eu
besoin d'appuyer sur la touche Suppr) ; et note bien que la valeur saisie n'est effacée
que si elle est hors tolérance : si c'est une bonne valeur, elle reste ! (heureusement)
perso, je préfère comme ça ! mais si tu préfères que la valeur erronée reste dans
la cellule de saisie après affichage du message "hors tolérance", alors utilise
le fichier joint ci-dessous.
Voici le code VBA sans effacement de la valeur erronée (hors tolérance) :
VB:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .CountLarge > 1 Then Exit Sub
If .Column <> 4 Then Exit Sub
Dim lig&: lig = .Row
If lig < 19 Or lig > 48 Then Exit Sub
If lig = 23 Or lig = 44 Then Exit Sub
If .Value >= Round([I10] * 0.7, 0) Then Exit Sub
Dim i As Byte
For i = 1 To 3 'Loop 3 times.
Beep
'PlaySound ThisWorkbook.Path & "\0257", 0, 1
Next i
MsgBox "Attention valeur hors tolérance"
End With
End Sub
et voici le code VBA avec effacement de la valeur hors tolérance :
Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .CountLarge > 1 Then Exit Sub
If .Column <> 4 Then Exit Sub
Dim lig&: lig = .Row
If lig < 19 Or lig > 48 Then Exit Sub
If lig = 23 Or lig = 44 Then Exit Sub
If .Value >= Round([I10] * 0.7, 0) Then Exit Sub
Dim i As Byte
For i = 1 To 3 'Loop 3 times.
Beep
'PlaySound ThisWorkbook.Path & "\0257", 0, 1
Next i
MsgBox "Attention valeur hors tolérance"
Application.EnableEvents = 0
.Value = Empty
Application.EnableEvents = -1
End With
End Sub
La seule différence entre les 2 codes VBA, c'est les 3 lignes
qui sont juste après le MsgBox et avant le End With.
Une dernière chose, sais-tu pourquoi For i = 1 To 3 ne s'applique pas ? (1 seul beep au lieu de 3)
Alors qu'avant toutes ces modifications ils fonctionnaient ?
dis-moi d'abord quelle version tu as préférée : avec effacement de la valeur hors tolérance ?
ou sans cet effacement ? c'est ton choix, hein ? fais comme tu veux : je t'oblige à rien !
La version sans effacement de la valeur hors tolérance est parfaite (c'est se que je souhaitais).
Juste 3 "beep" au lieu d'un et le sujet sera clos pour moi^^.
Merci encore pour le temps passé à m'aider et je reste impressionné par vos facilités en VBA (je dirai même un peu jaloux). Il faudrait que je m'y mette plus sérieusement mais je prends pas le tps...