Discussion :

[jarault]

Bonjour,

J'ai la macro suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err_SelectionChange
Dim Plage As Range
Dim Plage2 As Range
 
Application.ScreenUpdating = False
Set Plage = Range("I4:I700")
 
'Sort de la routine si ce n'est pas une cellule de produit
If Application.Intersect(ActiveCell, Plage) Is Nothing Then _
         GoTo Sort_SelectionChange
 
'Vérifie qu'une seule cellule est sélectionnée
If Target.Count > 1 Then
    MsgBox "Veuillez ne sélectionner qu'une seule cellule"
    GoTo Sort_SelectionChange
End If
 
'Lance la macro pour copier le produit choisi
Call Incorporer_Ventes
 
Sort_SelectionChange:
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
Err_SelectionChange:
MsgBox Err.Description, vbCritical + vbOKOnly, "ERREUR EXCEL N°" & Err.Number
Resume Sort_SelectionChange
End Sub

Mon problème est le suivant: la macro actuelle surveille bien la zone Range("I4:I700") en lançant la macro "Incorporer_Ventes", mais je n'arrive pas à modifier celle-ci pour quelle me surveille une deuxième zone sur la même feuille, à savoir la zone Range("C4:C700"). Pour résumer je souhaiterais que si le contenu de la première zone change, la macro "Incorporer_Ventes" soit lancée et si le contenu de la deuxième zone change la macro "Incorporer_Ventes2" soit lancée.

Merci par avance de votre aide.

NB.: est-il possible de récupérer la valeur de la cellule avant changement, par exemple si le contenu de la cellule est "1" et que je la modifie en "2" j'arrive à récupérer la valeur "2" mais je ne sais pas comment récupére le "1".

Jarault

[ouskel'n'or]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Plage As Range
Dim Plage2 As Range
    'Vérifie qu'une seule cellule est sélectionnée
    If Target.Count > 1 Then
        MsgBox "Veuillez ne sélectionner qu'une seule cellule"
        Exit Sub
    End If
    Set Plage = Range("I4:I700")
    Set Plage2 = Range("C4:C700")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    'On exécute la routine si c'est pas une cellule de produit
    If Not Application.Intersect(ActiveCell, Plage) Is Nothing Then
        'Lance la macro pour copier le produit choisi
        Call Incorporer_Ventes
       ElseIf Not Application.Intersect(ActiveCell, Plage2) Is Nothing Then
        Incorporer_Ventes2
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Si tu as des erreurs, ce sera dans les procédures appelées, tu n'as donc pas à les gérer ici où tu dois les régler autrement qu'avec un on error goto. Ce n'est qu'un conseil.
Bonne journée

[jarault]

Merci Ouskel'n'or,

Ton code fonctionne parfaitement.
Une idée pour récupérer l'ancienne valeur ?
Jarault

[ouskel'n'or]

Une idée ? Oui mais je ne vais pas avoir le temps d'approfondir. Y fait beau, je pars
L'idée : Consiste à mémoriser la valeur placée dans la cellule au moment où on entre dans cette cellule.
Pour ça, tu dois déclarer une variable public.
Dans SelectionChange, si tu rentres dans la cellule (tu vérifies donc l'adresse qui doit être la bonne ici) tu mémorises la valeur. Tempo = Target (*)
Mais cet événement se produit quelque soit la cellule sélectionnée. Donc, quelle qu'elle soit, tu vérifies que la valeur dans la cellule à tester est la même que dans la variable Tempo. Si elle est différente, tu fais ce que tu as à faire, et tu mets à jour la variable Tempo. Sinon, tu bouge pas.
(*) Attention, tu dois mettre à jour Tempo seulement après avoir vérifié le changement.
Donc, si tu pars d'une cellule vide, le test sera positif pour la première valeur saisie... Donc, tu y penses et si ça pose problème, tu réfléchis mais il y a un moyen avec if tempo = "" then... Tu devrais trouver... J'y vais !
Bonne journée
Bon trip
Bon courage
M...de ! Le soleil vient de se planquer !
A+

[jarault]

Je suis d'accord avec toi sur le principe, je venais d'y penser, il ne me reste plus qu'a faire mes premiers essais, on verra çà ce soir. Merci encore

C'est sans doute la facilité mais si je rajoutais çà:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Plage3 As Range
Set Plage3 = Range("C4:C700")
 
Application.ScreenUpdating = False
Application.EnableEvents = False
 
    'On exécute la routine si la cellule sélectionnée se trouve dans la colonne C quantité de produit
    If Not Application.Intersect(ActiveCell, Plage3) Is Nothing Then
        'Copie la valeur de quantité produit avant changement
        ActiveCell.Offset(0, 20) = ActiveCell.Value
    End If
 
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Après il ne me reste plus qu'a utiliser la valeur de la cellule ActiveCell.Offset(0, 20)
Jarault

[OrDonc]

Bonsoir,

Sans monopoliser une cellule, à tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim Original 'Public dans un Module, si utilisée ailleurs que dans cette feuille
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Not Application.Intersect(Target, Range("I4:I700,C4:C700")) Is Nothing Then
    Original = Target.Value
  End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then
        MsgBox "Veuillez ne sélectionner qu'une seule cellule"
        Exit Sub
    End If
    Application.EnableEvents = False 'entraîne un changement de sélection
    If Not Application.Intersect(Target, Range("I4:I700,C4:C700")) Is Nothing Then
      If Target.Column = 9 Then
        MsgBox "Vers 1, original = " & Original 'à rétablir : Incorporer_Ventes
      Else
        MsgBox "Vers 2, original = " & Original  'à rétablir : Incorporer_Ventes2
      End If
   End If
   Application.EnableEvents = True
End Sub