Discussion :

[nananinanana]

Bonjour encore,

La novice que je suis s'est lancée dans la réalisation de macro
Pas peu fière de moi (car oui même si pour vous c'est hyper easy pour moi cela relève plutôt du miracle) ma macro consiste en :

Je modifie ma cellule et un evénement msgbox s'ouvre pour confirmer la modification si "oui" on valide la cellule si "non" on remet la cellule précédente qui a été enregistrée.
En simultané à chaque modification de ces cellules un historique de modification s'ouvre dans la feuille "QQOQCCP" avec les champs Qui, Quoi, Quand(date), Quand(heure), Valeur avant modif, Valeur Après modif, et un champs Pourquoi qui doit être rempli par le modificateur (si il décide de modifier la cellule un userform apparaît)

Cette macro fonctionne très bien (ou presque) pour Range("D6: D2000") mais rien ne se passe pour Range("F6:BXY2000")

Aussi lorsque les lignes Worksheets("QQOQCCP").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Value="..." prennent uniquement en compte la cellule d'au dessus et non pas la ligne, il suffit qu'une cellule soit vide et le End(xlUp) va automatiquement sur la ligne déjà renseignée mais avec 1 cellule vide ce qui risque de provoquer un décalage dans mon historique QQOQCCP, comment empêcher ça ?

Enfin j'aurai voulu que pour la plage "F6:BXY2000" un message un peu différent s'affiche lors de la modification, en précisant dans la feuille "QQOCCCP" si on a modifié sur la plage "D6: D2000" ou "F6:BXY2000" (en rajoutant une colonne "type de modification" par exemple)

Je ne sais pas si j'ai été très claire, mais voici mon petit code et merci d'avance à mes futurs sauveurs!

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
30
Option Explicit
Dim ValCell As Variant
Dim PreviousValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
  Or Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
  Application.EnableEvents = False
   If MsgBox("Êtes-vous certain de modifier la révision", vbYesNo + vbExclamation + vbDefaultButton2) = vbNo Then
    Target.Value = ValCell
    Worksheets("QQOQCCP").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Value = "Pas de modification"
    Else
    Pourquoi.Show
    End If
  Application.EnableEvents = True
 End If
If Target.Value <> PreviousValue Then
Worksheets("QQOQCCP").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Environ("Username")
Worksheets("QQOQCCP").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Cells(Target.Row, 2).Value
Worksheets("QQOQCCP").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = ValCell
Worksheets("QQOQCCP").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = Target.Value
Worksheets("QQOQCCP").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Value = Date
Worksheets("QQOQCCP").Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Value = Hour(Now) & ":" & Minute(Now)
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
  Or Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
ValCell = Target
End If
End Sub

[unparia]

Bonjour,
déjà :

Code :

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

1
2
If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
  Or Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then

fait que la condition n'est jamais réunie, puisque si dans l'un, impossible d'être dans l'autre (et donc l'un des deux est forcément Nothing).
Ce OR devrait être un AND.
(je n'ai pas regardé le reste).

[eric4459]

Bonjour Nananinanana
As-tu essayé avec des parenthèses comme ceci?

Code :

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

1
2
If Not ( Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
  Or Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing )Then

Unparia,

fait que la condition n'est jamais réunie

As-tu bien lu?

Cette macro fonctionne très bien (ou presque) pour Range("D6: D2000") mais rien ne se passe pour Range("F6:BXY2000")

C'est donc que la condition fonctionne en partie

Eric

[joe.levrai]

Bonjour,

oui pour moi c'est bien un problème de "Not" qui ne s'applique que sur le premier Intersect

Soit on factorise, comme le propose eric, soit on met également un "Not" devant le second Intersect

Sinon, ton test se lit : Si on est dans la première plage OU qu'on est pas dans la seconde plage
ce qui explique que ça ne fonctionne pas pour ta seconde plage

[unparia]

Si l'on ne veut pas se lancer dans la nécessité de réfléchir sur ce que sont les doubles négations et leur transposition en code, le plus simple est encore :
- de garder à l'esprit que la méthode intersect s'applique parfaitement à une plage discontinue
- et donc de l'appliquer tout bêtement à la plage constituée des deux "sous-plages" à traiter, ainsi :

Code :

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

If Not Intersect(Target, Union(Range("D6:D2000"), Range("F6:BXY2000"))) Is Nothing Then

voilà tout.

[joe.levrai]

Je suis d'accord sur le principe de factoriser également les deux plages par Union

Mais, si je ne l'ai pas proposé, c'est qu'elle alourdira la mise en place de sa seconde problématique, qui est de customiser certaines parties en fonction de l'une ou l'autre des deux plages. Il va falloir (en plus de l'union) refaire un teste pour vérifier dans laquelle des deux on est.

Alors qu'avec le double Not, pour régler ses souhaits ultérieurs, il suffira de dissocier les deux tests sur un If/ElseIf
Enfin, avec les deux ça marche (et d'ailleurs, c'est quasi transparent sur la partie customisée qu'il faut précisément mettre en oeuvre ici).

[unparia]

Bonjour joe.levrai
le test de dissociation est ici de la plus grande simplicité avec ce mécanisme :
1) on est ou non dans la plage spécifiée par la méthode Union
2) puisque l'on y est, plus besoin de tester par intersect

Code :

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

1
2
3
4
5
6
select case target.column
  case 4
 ...
  case else
 ...
end select

[joe.levrai]

Bonjour,

je préfère ta proposition, mais seulement quand on a pas une double condition sur la plage.
Là faut aussi tester qu'on est bien entre la ligne 6 et 2000, ce qui va imbriquer deux tests en passant par Column et Row.

en dissociant directement le Intersect (If/Elseif) on fait d'une pierre deux coups ?

[unparia]

Là faut aussi tester qu'on est bien entre la ligne 6 et 2000

Non, joe.levrai. Pourquoi re-tester ce qui l'a déjà été ?
Si nous arrivons jusqu'au select case, c'est que target est DEJA dans la plage (et ne saurait donc être hors de la plage). Il nous suffit dès lors de regarder dans quelle colonne elle (tiens ... j'emploie le féminin pour target alors que c'est un mot neutre en anglais) est.
Amitiés

[joe.levrai]

Ah tu veux tester la colonne après les intersect.

Je pensais que tu voulais passer à un test unique en le supprimant, et je n'arrivais pas à concevoir la pirouette.

Sinon, on peut très bien couper en deux le traitement :

1) Double intersect pour vérifier qu'on est bien dans la bonne plage
2) un Booléen pour gérer le msgbox
3) Ensuite (on est sorti du If intersect) on agit en fonction du Booléen pour effacer la saisie ou afficher le formulaire de récolte des éléments complémentaires.

[nananinanana]

Merci à tous pour vos réponses !

alors j'ai testé avec vos conseil le code suivant qui a répondu à la problématique d'utiliser 2 plages non adjacentes alors merci !

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
30
31
32
33
34
35
36
Option Explicit
Dim ValCell As Variant
Dim PreviousValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
  Or Not Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
  Application.EnableEvents = False
   If MsgBox("Êtes-vous certain de modifier la révision", vbYesNo + vbExclamation + vbDefaultButton2) = vbNo Then
    Target.Value = ValCell
    Worksheets("QQOQCCP").Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).Value = "Pas de modification"
    Else
    Pourquoi.Show
    End If
  Application.EnableEvents = True
 End If
If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing Then
Worksheets("QQOQCCP").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Value = "Révision ligne"
End If
If Not Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
Worksheets("QQOQCCP").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Value = "Révision matrice"
End If
If Target.Value <> PreviousValue Then
Worksheets("QQOQCCP").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Environ("Username")
Worksheets("QQOQCCP").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Cells(Target.Row, 2).Value
Worksheets("QQOQCCP").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = ValCell
Worksheets("QQOQCCP").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = Target.Value
Worksheets("QQOQCCP").Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).Value = Date
Worksheets("QQOQCCP").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Value = Hour(Now) & ":" & Minute(Now)
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
  Or Not Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
ValCell = Target
End If
End Sub

Mais je rencontre 2 problèmes dans la copie sur la feuille "QQOQCCP":

Premièrement dans la copie des valeurs avant et après modif :

Code :

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

1
2
3
 
Worksheets("QQOQCCP").Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = ValCell
Worksheets("QQOQCCP").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = Target.Value

Lorsque la modification consiste en la suppression de la cellule, rien du tout ne s'affiche sur la feuille ni valeur avant ni valeur après ni Username ni rien !

aussi le code Cells(Rows.Count, 3).End(xlUp) renvoi à la dernière cellule vide, hors je voudrais que cela renvoi à la dernière cellule vide DE la dernière ligne vide (je ne sais pas si je m'explique très bien)

J'essaie de faire le code le plus simple possible pour pouvoir le manipuler

Merci d'avance

[joe.levrai]

Bonjour,

une proposition pour illustrer le propos que nous avons avec un paria

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
30
31
32
33
34
35
36
37
38
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Continuer As Boolean, MaLigne As Long
 
' on vérifie qu'on est sur l'une des deux plages, et on demande de continuer ou non
If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
Or Not Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
    Continuer = MsgBox("Êtes-vous certain de modifier la révision ", vbYesNo + vbExclamation + vbDefaultButton2)
Else
    Exit Sub
End If
 
Application.EnableEvents = False
    With Worksheets("QQOQCCP")
        ' calcul de la première ligne vide sur les 8 colonnes
        MaLigne = .UsedRange.Resize(, 8).Find("*", , , , xlRows, xlPrevious).Row + 1
 
        ' si on ne continue pas
        If Not Continuer Then
            Target.Value = ValCell
            .Cells(MaLigne, 8).Value = "Pas de modification"
 
        ' si on continue
        Else
            Pourquoi.Show
 
            ' on injecte les 7 valeurs directement en passant un tableau
            If Target.Value <> PreviousValue Then
                .Cells(MaLigne, 1).Resize(1, 7).Value = Array(Environ("USERNAME"), _
                                                              Cells(Target.Row, 2).Value, _
                                                              ValCell, Target.Value, _
                                                              IIf(Target.Column = 4, "Révision ligne", "Révision matrice"), _
                                                              Date, _
                                                              Hour(Now) & ":" & Minute(Now))
            End If
        End If
    End With
Application.EnableEvents = True
End Sub

[nananinanana]

J'ai testé, ça repond bien au problème de passer à la ligne de dessous,

Seulement la valeur avant n'apparaît pas et dans le cas ou je choisi "non" dans ma Msgbox le userforme s'ouvre quand même et surtout l'ancienne valeur n'est pas rétablie !

Aussi si je supprime la cellule aucune donnée n'apparaît non plus ni même la date et l'heure absoluement rien

Je vous joins le fichier ça sera peut-être plus parlant

En tout cas merci encore joe.levrai vous êtes des génies !

[unparia]

Remplace

Code :

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

dim continuer as boolean

par

Code :

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

dim continuer as integer

et

Code :

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

If Not Continuer Then

par

Code :

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

if continuer = vbno then

[nananinanana]

Le problème qui persiste : rien ne s'affiche dans la colonne "pourquoi"

Edit : problème réglé ! Il s'agissait de mon Userform qui était déchargé !

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Option Explicit
Dim Continuer As Integer, MaLigne As Long
Dim ValCell As Variant
Dim PreviousValue As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
' on vérifie qu'on est sur l'une des deux plages, et on demande de continuer ou non
If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
Or Not Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
    Continuer = MsgBox("Êtes-vous certain de modifier la révision ", vbYesNo + vbExclamation + vbDefaultButton2)
Else
    Exit Sub
End If
 
Application.EnableEvents = False
    With Worksheets("QQOQCCP")
        ' calcul de la première ligne vide sur les 8 colonnes
        MaLigne = .UsedRange.Resize(, 8).Find("*", , , , xlRows, xlPrevious).Row + 1
 
        ' si on ne continue pas
        If Continuer = vbNo Then
            Target.Value = ValCell
 
        ' si on continue
        Else
             Pourquoi.Show
            ' on injecte les 8 valeurs directement en passant un tableau
            .Cells(MaLigne, 1).Resize(1, 8).Value = Array(Environ("USERNAME"), _
                                                              Cells(Target.Row, 2).Value, _
                                                              ValCell, Target.Value, _
                                                              IIf(Target.Column = 4, "Révision ligne", "Révision matrice"), _
                                                              Date, _
                                                              Hour(Now) & ":" & Minute(Now), Pourquoi.TextBox1.Text)
            End If
        End With
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("D6:D2000")) Is Nothing _
  Or Not Application.Intersect(Target, Range("F6:BXY2000")) Is Nothing Then
ValCell = Target
End If
End Sub