OVH Cloud OVH Cloud

Worksheet_Change à probleme

8 réponses
Avatar
Nicolas S
Bonjour,
grâce à une réponse de micedenis du 20 janvier 2003, j'ai réussi à faire
cela:

Option Explicit
Dim fin

Private Sub Worksheet_Change(ByVal Target As Range)
Dim coef
Dim zz
If Not Intersect(Target, Range("d4:d34")) Is Nothing Then coef = 1.055
If Not Intersect(Target, Range("e4:e34")) Is Nothing Then coef = 1.196
If Not Intersect(Target, Range("f4:f34")) Is Nothing Then coef = 1.021
If Intersect(Target, Range("d4:f34")) Is Nothing Then Exit Sub
If fin = 1 Then GoTo fin2
fin = 1
ActiveCell.Offset(-1, 0).Select
suite:
zz = ActiveCell.Value
If fin = 0 Then Exit Sub
On Error GoTo fin2
ActiveCell.Value = zz * coef
ActiveCell.Offset(1, 0).Select
fin2:
fin = 0
End Sub



le code marche bien......... mais il y à un problème:

quand je fait supprime sur une cellule "de D4 à D34" le code ce lance et
modifie la cellule supérieur ce qui est gênant.
Comment y remédier????

(excel 97)

merci et bon week end "d'études" marseillais

8 réponses

Avatar
AV
Comment y remédier????


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Value = "" Then Exit Sub
....etc......

AV

Avatar
Nicolas S
bonjour et merci pour ta réponse pleine de bon sens
Mais j'ai un autre problème, je souhaiterai que le code marche uniquement en
utilisant la touche validation, pour que l'instruction
ActiveCell.Offset(-1, 0).Select désigne bien la dernière cellule entrée.
Ce qui n'est pas le cas si l'on utilise "les touches de directions" ou si
l'on clique dans une autre cellule.
@ plus et respectueusement Nicolas
AV a écrit dans le message ...
Comment y remédier????


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Value = "" Then Exit Sub
....etc......

AV





Avatar
michdenis
Bonjour Nicolas S,

A ) une réponse de micedenis : MichDenis
Mice : small rodent with a long tail and a pointy face with little round ears; hand-size input device with buttons that
when moved across a surface causes the cursor on the screen to move in the same direction (Computers); coward, shy
person (Slang)

B ) Avec des goto et des variables "zz" ... ça ressemble plus à du code de AV ! ;-)))

C ) Dans ta procédure, Target est la cellule active qui vient tout juste d'être modifié (Passage à l'état d'édition de
la cellule), En conséquence, si tu veux inscrire sur la même ligne que Target, une information dans la colonne suivante
ou précédente, je te recommande fortement d'utiliser dans ton code "target" plutôt que "ActiveCell" pour signifier à ta
procédure où l'information doit être inscrite. Si tu veux faire un test, inscrit une valeur dans une cellule et utilise
la souris pour valider l'information saisie et sélectionnant une cellule quelconque à l'autre extrémité du tableau.

dans une nouvelle feuille pour ton test, tu peux utiliser ceci :
'--------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox Target.Address
MsgBox ActiveCell.Address
End Sub
'--------------------------

La conclusion est évidente ....!!!


D ) Dans la mesure du possible, il faut éviter d'utiliser dans des routines les "Goto" ....le code devient vite
"illisible" ... voir confus !

E ) Les procédures événementielles réagissent aux actions de l'usager fait de la feuille. Dans ton cas précis, tu dois
désactiver l'événement "Worksheet_Change" si tu modifies le contenu d'une cellule afin d'éviter que la procédure
s'appelle elle-même ! Pour ce faire, il faut utiliser la ligne de code suivante :

Application.EnableEvents = False
Range("DP16") = 25
Application.EnableEvents = True

T'avoueras que c'est moins compliqué que de gérer les Goto


F ) Pour inscrire une information dans une cellule, Nul besoin de la sélectionner ..


G ) Si j'ai compris, ta procédure pourrait ressembler à ceci :
'-----------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim coef As Double, zz As Double

If Not Intersect(Target, Range("d4:d34")) Is Nothing Then coef = 1.055
If Not Intersect(Target, Range("e4:e34")) Is Nothing Then coef = 1.196
If Not Intersect(Target, Range("f4:f34")) Is Nothing Then coef = 1.021
If Intersect(Target, Range("d4:f34")) Is Nothing Then Exit Sub

Application.EnableEvents = False
Target.Offset(-1).Value = Target.Offset(-1) * coef
Target.Select
Application.EnableEvents = True

End Sub
'-----------------------


Salutations!






"Nicolas S" a écrit dans le message de news:clc0so$80h$
Bonjour,
grâce à une réponse de micedenis du 20 janvier 2003, j'ai réussi à faire
cela:

Option Explicit
Dim fin

Private Sub Worksheet_Change(ByVal Target As Range)
Dim coef
Dim zz
If Not Intersect(Target, Range("d4:d34")) Is Nothing Then coef = 1.055
If Not Intersect(Target, Range("e4:e34")) Is Nothing Then coef = 1.196
If Not Intersect(Target, Range("f4:f34")) Is Nothing Then coef = 1.021
If Intersect(Target, Range("d4:f34")) Is Nothing Then Exit Sub
If fin = 1 Then GoTo fin2
fin = 1
ActiveCell.Offset(-1, 0).Select
suite:
zz = ActiveCell.Value
If fin = 0 Then Exit Sub
On Error GoTo fin2
ActiveCell.Value = zz * coef
ActiveCell.Offset(1, 0).Select
fin2:
fin = 0
End Sub



le code marche bien......... mais il y à un problème:

quand je fait supprime sur une cellule "de D4 à D34" le code ce lance et
modifie la cellule supérieur ce qui est gênant.
Comment y remédier????

(excel 97)

merci et bon week end "d'études" marseillais
Avatar
AV
B ) Avec des goto et des variables "zz" ... ça ressemble plus à du code de AV
! ;-)))


Hum... hum... m'est avis que non !

** (ByVal Target As Range)
Probabilité infime que ce soit de moi !

** "Dim zz"
Bofff et surement pas de moi car déclarer une variable sans type (je ne te
l'apprends pas) revient à la déclarer "Variant" donc absolument aucune économie
par rapport à une absence de déclaration !

D ) Dans la mesure du possible, il faut éviter d'utiliser dans des routines les
"Goto" ....le code devient vite

"illisible" ... voir confus !


Ca c'est la position de principe qui louable et qui ne devrait s'appliquer qu'à
l'utilisation des gotos pour boucler
Mais ériger ça en dogme est une position ayatollesque !
A bas les fatwas oulemanesques !
Les gotos ça peut toujours servir (Ex : la gestion d'erreur )

AV

Avatar
Daniel.M
Alain,

D ) Dans la mesure du possible, il faut éviter d'utiliser dans des routines
les


"Goto" ....le code devient vite
"illisible" ... voir confus !


Ca c'est la position de principe qui louable et qui ne devrait
s'appliquer qu'à l'utilisation des gotos pour boucler


Ça me semble assez superflu également lorsque vient le temps de remplacer un
If Then Else (comme le cas ci-haut).


Mais ériger ça en dogme est une position ayatollesque !
Les gotos ça peut toujours servir (Ex : la gestion d'erreur )


C'est en effet la manière que VB/A effectue sa gestion d'erreur et on n'a pas le
choix ... en attendant AOP (aspect oriented programming) dans VBA (pas demain la
veille).

Moins réjouissant: l'usage des Gotos en VBA est fréquent car il résulte de la
façon dont sont malheureusement programmées certaines fonctions/méthodes d'Excel
qui ne trouvent pas une valeur (WorksheetFunction.Match) ou une cellule
(.SpecialCells). Ça, avec une meilleure implantation de ces fonctions/méthodes,
on aurait pu s'en passer.

Salutations,

Daniel M.


Avatar
Nicolas S
Merci pour vos réponces,

maintenant grâce à vous le code est ainsi

Private Sub Worksheet_Change(ByVal Target As Range)
Dim coef As Double, zz As Double
Dim z As Long
Dim xx
Dim ww As Long
Dim cinq
Dim ttc As Long
Dim TP
If Intersect(Target, Range("c4:e34")) Is Nothing Then Exit Sub
On Error Resume Next
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, Range("d4:d34")) Is Nothing Then coef = 1.055
If Not Intersect(Target, Range("e4:e34")) Is Nothing Then coef = 1.196
If Intersect(Target, Range("d4:e34")) Is Nothing Then GoTo total

z = Target.Value * coef
Target.Value = z
Target.Select
Application.EnableEvents = True
Exit Sub
total:
xx = Target.Value
Target.Select
ActiveCell.Offset(0, 3).Select
TP = ActiveCell.Value
ActiveCell.Offset(0, -3).Select
ttc = (xx * 1.021) - TP
ActiveCell.Value = ttc
Application.EnableEvents = True
End Sub

Pour la partie qui est en dessous de total, je l'avais mise dans une autre
procedure qui était appelée par l'instruction:If Intersect(Target,
Range("d4:e34")) Is Nothing total, mais target n'y etait pas reconnu.

Il est vrai que Application.EnableEvents = True ou false rend les choses
plus lisible, mais quant je test le code par F8 et que j'arrête le code
aprés avoir passé l'instruction Application.EnableEvents = False ca marche
beaucoup moins bien pour faire partir le code:-((((.

Alain excuse moi si j'ai preferé les solutions de Denis, comme tu as du
le remarquer le code concerne les taux de TVA et non pas de T.....AV
;-)))). (If Target.Value = "" Then Exit Sub figure dans le code)
.
Excuse moi Denis pour avoir ecorché ton pseudo, cela doit être un reste
des evenements de cet été.
Au milieu de la nuit, je sens quelque chose qui vient me chatouiller la
main. je me dis que c'est probablement un papillon de nuit (nous dormons la
fenètre ouverte) Je secoue la main pour faire partir l'intrus et là
j'entends qq chose tomber par terre!!!!!! .J'allume la lumière et je vois à
ma surprise une souris se cacher sous l'armoire. Je vais à la fenètre
appeler notre felin pour venir nous débarasser du rongeur, ce qu'elle fit
sans se faire prier.



Et encore une fois merci aux contributeurs du forum pour leur
dévouement.
Avatar
AV
Alain excuse moi si j'ai preferé les solutions de Denis,


Heu, sur le principe, ça m'est totalement "équidistant", mais si je lis les 2
seules lignes de code que je t'ai proposé le 23/10/04 10:52

On Error Resume Next
If Target.Value = "" Then Exit Sub

elles figurent in-extenso dans ton code !

A part ça, tu fais, évidemment ce que tu veux ;-)
AV

Avatar
michdenis
Bonjour Nicolas,

As-tu essayé quelque chose comme ceci :

Dans les cas de figure simple, il n'est pas nécessaire d'utiliser des variables comme intermédiaire...bien que ce n'est
pas une erreur de le faire ...
J'ai remplacé ta formule Goto par un "if else then".

'-----------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

Dim coef As Double

On Error Resume Next
If Intersect(Target, Range("c4:e34")) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub

If Not Intersect(Target, Range("d4:d34")) Is Nothing Then coef = 1.055
If Not Intersect(Target, Range("e4:e34")) Is Nothing Then coef = 1.196
If Not Intersect(Target, Range("d4:e34")) Is Nothing Then
Application.EnableEvents = False
Target = (Target.Value * 1.021) - Target.Offset(1, 3)
Target.Select
Application.EnableEvents = True
Else
Application.EnableEvents = False
Target.Value = Target.Value * coef
Target.Select
Application.EnableEvents = True
End If

End Sub
'-----------------------------


Salutations!



"Nicolas S" a écrit dans le message de news:clie3a$ba0$
Merci pour vos réponces,

maintenant grâce à vous le code est ainsi

Private Sub Worksheet_Change(ByVal Target As Range)
Dim coef As Double, zz As Double
Dim z As Long
Dim xx
Dim ww As Long
Dim cinq
Dim ttc As Long
Dim TP
If Intersect(Target, Range("c4:e34")) Is Nothing Then Exit Sub
On Error Resume Next
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, Range("d4:d34")) Is Nothing Then coef = 1.055
If Not Intersect(Target, Range("e4:e34")) Is Nothing Then coef = 1.196
If Intersect(Target, Range("d4:e34")) Is Nothing Then GoTo total

z = Target.Value * coef
Target.Value = z
Target.Select
Application.EnableEvents = True
Exit Sub
total:
xx = Target.Value
Target.Select
ActiveCell.Offset(0, 3).Select
TP = ActiveCell.Value
ActiveCell.Offset(0, -3).Select
ttc = (xx * 1.021) - TP
ActiveCell.Value = ttc
Application.EnableEvents = True
End Sub

Pour la partie qui est en dessous de total, je l'avais mise dans une autre
procedure qui était appelée par l'instruction:If Intersect(Target,
Range("d4:e34")) Is Nothing total, mais target n'y etait pas reconnu.

Il est vrai que Application.EnableEvents = True ou false rend les choses
plus lisible, mais quant je test le code par F8 et que j'arrête le code
aprés avoir passé l'instruction Application.EnableEvents = False ca marche
beaucoup moins bien pour faire partir le code:-((((.

Alain excuse moi si j'ai preferé les solutions de Denis, comme tu as du
le remarquer le code concerne les taux de TVA et non pas de T.....AV
;-)))). (If Target.Value = "" Then Exit Sub figure dans le code)
.
Excuse moi Denis pour avoir ecorché ton pseudo, cela doit être un reste
des evenements de cet été.
Au milieu de la nuit, je sens quelque chose qui vient me chatouiller la
main. je me dis que c'est probablement un papillon de nuit (nous dormons la
fenètre ouverte) Je secoue la main pour faire partir l'intrus et là
j'entends qq chose tomber par terre!!!!!! .J'allume la lumière et je vois à
ma surprise une souris se cacher sous l'armoire. Je vais à la fenètre
appeler notre felin pour venir nous débarasser du rongeur, ce qu'elle fit
sans se faire prier.



Et encore une fois merci aux contributeurs du forum pour leur
dévouement.