XL 2021 Impossible d'annuler une modification dans un fichier

[BJ1]

Bonjour,

J'ai un fichier avec une macro modifiant automatiquement une date en cas de modification. Cette macro marche parfaitement sur d'autres fichiers, mais, sur celui-ci, cela provoque le blocage de la fonction 'annuler' en cas de modification d'une cellule, par exemple dans les colonnes A à C. Pourquoi ?

Je ne repère rien dans mes macros qui vide le presse papier ou qui annule cette fonction, et, d'ailleurs, ces macros marchent parfaitement ailleurs.

Rien non plus dans les options du fichier : le calcul automatique est bien activé, et les options excel sont les mêmes que pour les autres fichiers où la fonction 'annuler' marche.

Fermer et relancer excel ne change rien.

Ma version Excel : Microsoft Office LTSC Standard 2021

 

[vgendron]

bonjour

Ce n'est pas un problème de version ou d'option, ce qui a été fait par une macro ne peut PAS etre annulé par le bouton "Annuler"

 

[sylvanu]

Bonjour BJ1, et bienvenu sur XLD, bonjour Vgendron.

Cette macro marche parfaitement sur d'autres fichiers

Cela m'étonne beaucoup.
Quand une macro effectue une action, elle ne peut pas être annulée par Ctrl+Z ( Annuler )
Votre macro agit sur les colonne A:C. Essayez de modifier une cellule en colonne D puis Annuler, ça marche très bien.
En fait l'action peut être annulée si la cellule est hors de la plage définie par WorkSheet_Change.

Pouvez vous vérifier sur un autre fichier que si une modif se fait dans une cellule traitée par WorkSheet_Change, l'action d'annuler est possible ?

 

[Dranreb]

Bonjour.
Dans Feuil1 :

Option Explicit
Private ClnSvg As New Collection, AncCbl As Range, Valeur, AncDate
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Rows.Count > 1 Or Target.Columns.Count > 1 _
      Or Intersect(Me.[A:C], Target) Is Nothing Then Exit Sub
   NoterSelection Target, Intersect(Me.Columns(6), Target.EntireRow).Value
   End Sub
Private Sub WorkSheet_Change(ByVal Target As Range)
   If Target.Rows.Count > 1 Or Target.Columns.Count > 1 _
      Or Intersect(Me.[A:C], Target) Is Nothing Then Exit Sub
   Intersect(Me.Columns(6), Target.EntireRow).Value = Date ' Fusille forcément le Ctrl+Z
   NoterChangement Target ' Pour établir une alternative.
   End Sub

Dans un module standard :

Option Explicit
Private ClnSvg As New Collection, Cible As Range, Valeur, AncDate
Public Sub NoterSelection(ByVal Target As Range, ByVal LaDate)
   Set Cible = Target: Valeur = Cible.Value: AncDate = LaDate
   End Sub
Public Sub NoterChangement(ByVal Target As Range)
   If Target.Address <> Cible.Address Then Exit Sub
   ClnSvg.Add Array(Cible, Valeur, AncDate)
   Application.OnUndo "Annuler", "Défaire"
   End Sub
Public Sub Défaire()
   Dim T()
   T = ClnSvg.Item(ClnSvg.Count): ClnSvg.Remove ClnSvg.Count
   Application.EnableEvents = False
   T(0).Value = T(1)
   Intersect(T(0).Worksheet.Columns(6), T(0).EntireRow).Value = T(2)
   Application.EnableEvents = True: If ClnSvg.Count = 0 Then Exit Sub
   Application.OnUndo "Annuler", "Défaire"
   End Sub

 

[BJ1]

Pouvez vous vérifier sur un autre fichier que si une modif se fait dans une cellule traitée par WorkSheet_Change, l'action d'annuler est possible ?

En effet, quand on fait une modif hors des colonnes A à C, l'annulation est possible !
Merci !

 

[BJ1]

Bonjour.
Dans Feuil1 :

Option Explicit
Private ClnSvg As New Collection, AncCbl As Range, Valeur, AncDate
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Rows.Count > 1 Or Target.Columns.Count > 1 _
      Or Intersect(Me.[A:C], Target) Is Nothing Then Exit Sub
   NoterSelection Target, Intersect(Me.Columns(6), Target.EntireRow).Value
   End Sub
Private Sub WorkSheet_Change(ByVal Target As Range)
   If Target.Rows.Count > 1 Or Target.Columns.Count > 1 _
      Or Intersect(Me.[A:C], Target) Is Nothing Then Exit Sub
   Intersect(Me.Columns(6), Target.EntireRow).Value = Date ' Fusille forcément le Ctrl+Z
   NoterChangement Target ' Pour établir une alternative.
   End Sub

Dans un module standard :

Option Explicit
Private ClnSvg As New Collection, Cible As Range, Valeur, AncDate
Public Sub NoterSelection(ByVal Target As Range, ByVal LaDate)
   Set Cible = Target: Valeur = Cible.Value: AncDate = LaDate
   End Sub
Public Sub NoterChangement(ByVal Target As Range)
   If Target.Address <> Cible.Address Then Exit Sub
   ClnSvg.Add Array(Cible, Valeur, AncDate)
   Application.OnUndo "Annuler", "Défaire"
   End Sub
Public Sub Défaire()
   Dim T()
   T = ClnSvg.Item(ClnSvg.Count): ClnSvg.Remove ClnSvg.Count
   Application.EnableEvents = False
   T(0).Value = T(1)
   Intersect(T(0).Worksheet.Columns(6), T(0).EntireRow).Value = T(2)
   Application.EnableEvents = True: If ClnSvg.Count = 0 Then Exit Sub
   Application.OnUndo "Annuler", "Défaire"
   End Sub

Merci beaucoup pour les macros ! Il y a encore un petit message d'erreur que je pense pouvoir régler.
Merci infiniment !