SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

dasporto · 13 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

skoobi à dit:
Bonjour dasporto,

tu as oublié de copier le userform avec son code (dossier "Feuilles").
J'ai pas pu testé car il y a des mots de passe partout...

Bon test.

Bonjour Skoobi,

J'ai inclu mes pages dans ton SuiviX_v2.1.xls c'est plus simple je n'ai eu aucun soucis ça marchait bien jusqu'à que je partage le classeur.

Depuis à l'ouverture du document j'ai une erreur du type :
Run-time error '91':
Object variable or With block variable not set

En cliquant sur Debug il me pointe sur :

For Each CtlSuiviX In MenuSuiviX.Controls

dans le module M_Menus

Voici le fichier dont je me suis servi pour faire le test j'ai enlevé tous les mots de passe désolé.

Cijoint.fr - Service gratuit de dépôt de fichiers

Merci de ton aide.

dasporto · 13 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Re skoobi,
J'ai refait le test en entien et je me suis apperçu que la 1ère fois ou j'ai partagé le classeur j'ai redémarré le classeur juste après et j'ai eu cette erreur.(photo ci jointe) Je ne peux pas cliquer sur debug vu que le classeur est protégé et partagé pas d'accès au code vba.

Cijoint.fr - Service gratuit de dépôt de fichiers

Puis après avoir enlevé la protection et le partage du classeur, à l'ouverture j'ai le message expliqué au dessus.

Voici le fichier du dernier test.
Cijoint.fr - Service gratuit de dépôt de fichiers

Merci de ton aide.
Dasporto

skoobi · 15 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Re bonjour dasporto,

ça ne va pas beaucoup t'aider ce que je vais te dire: le test fonctionne chez-moi...

Edit: il est clair que le partage du classeur peut poser problème et je n'ai pas de solution pour cela. Par contre, la protection du classeur ne devrait pas poser de problème.

dasporto · 26 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Bonjour Skoobi,
J'ai règlé mes anciens problèmes, maintenant c'est plutot des questions de fonctionnement.
Lorsque je copie des données dans un autre classeur et je viens faire un collage speciale des valeurs dans mon classeur suivi. Dans la feuille Suivix>>HistCell il me met par exemple 5 fois la valeur 1 alors que les données collées vont de 1 à 5.

As-tu le meme phénomène.
Dasporto.

skoobi · 26 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Bonjour dasporto,

bonne remarque. En effet, la copie depuis un autre fichier n'est pas détectée avec mon utilitaire mais c'est chose faite maintenant

.
Je vais mettre la nouvelle version, 2.2, en dispo mais avant tout voici le code de "Thisworkbook" qu'il faut remplacer en entier dans ton fichier

Code:

'---------------------------------------------------------------------------------------
' Titre     : SuiviX
' Auteur    : Skoobi
' Date      : 26/04/2010
' Sujet     : Suivi des modifications des cellules, feuilles et codes VBA
'---------------------------------------------------------------------------------------
'++++++++ déclarations gestion cellule +++++++++
Dim DerLig As Long, DerCol As Long
Dim Lig As Long, Col As Long, PlageAddress As String, StateUndo As Boolean, UndoDo As Boolean
Dim LastChange As String
Dim NewSel As Range, ModeCutCopy As Byte, AdressCutCopy As String
Dim ListCutCopy() As Variant, StopFormat As Boolean
Dim SaveDetect As Boolean, DetectDeplace As Byte, OpSh As String, CloseDetect As Boolean
Dim XLAInstalled As Boolean
Dim AutreClasseur As String

Private WithEvents AppSuiviX As Application
'Permet de détecter la suppression de module via le menu ou clic droit pour avertir l'utilisateur
Private WithEvents EvntDelModuleMenu As CommandBarEvents, WithEvents EvntDelModulePopUp As CommandBarEvents

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&& Partie gestion du fichier SuiviX.xla &&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Private Sub Workbook_Open()

'vérifie que le fichier est installé et non ouvert comme un fichier ordinaire
Set AppSuiviX = Application
On Error Resume Next
XLAInstalled = AddIns("SuiviX_v2.1").Installed
If Err.Number > 0 Then
  MsgBox "Ce fichier est une macro complémentaire à installer via Outils>Macros complémentaire", vbCritical
  ThisWorkbook.Close
  Exit Sub
End If
'création des menus et contrôles
Call P_InitMenu
SuiviCellNon = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call P_DelMenu
End Sub

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& Partie gestion des fichiers ouverts &&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

Private Sub AppSuiviX_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If Wb.Name = ThisWorkbook.Name Then Exit Sub '!!!! A activer pour le xla !!!!
CloseDetect = True
End Sub

Private Sub AppSuiviX_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Wb.Name = ThisWorkbook.Name Then Exit Sub ' !!!! A activer pour le xla !!!!
'############# met à jour la feuille de suivi VBA si actif ###########
If SuiviVBAOui(Wb) Then
  Set WbX = Wb
  Call P_VBACompare
  Call P_FeuilSuiviPleine("SuiviX>>HistVBA", 2000, Wb)
End If
'############# met à jour la feuille de suivi cellule si actif ###########
If SuiviCellNon Then Exit Sub
'############# détection format de feuille ###########
If NbSh = Wb.Sheets.Count And Not NomSh Like "SuiviX>>Hist*" Then  'pour détecter la suppression/création d'une feuille
  Call FormatCell: Call CommentCell: Call FusCell
  SaveDetect = True
End If
'############# détection opération de feuille ###########
Call OperationsFeuil
If Not SuiviCellNon Then Call P_FeuilSuiviPleine("SuiviX>>HistCell", 500, Wb)
End Sub

Private Sub AppSuiviX_WorkbookDeactivate(ByVal Wb As Workbook)
If CloseDetect Then
  CloseDetect = False
  Exit Sub
End If
'Si on effectue une modification de code et que l'on active un autre fichier, "WorkbookDeactivate"
'fait la mise à jour dans la feuille de suivi avant de passer à cet autre fichier.
If SuiviVBAOui(Wb) Then
  Set WbX = Wb
  Call P_VBACompare
  Call P_FeuilSuiviPleine("SuiviX>>HistVBA", 2000, Wb)
End If
End Sub

Private Sub AppSuiviX_WorkbookOpen(ByVal Wb As Workbook)
'La condition suivante permet de tout de suite prendre en charge le suiviVBA du fichier actif lors de l'installation
'de l'utilitaire (pas nécessaire de fermer et ouvrir ce fichier).
If Not XLAInstalled And Wb.Name = ThisWorkbook.Name Then Call P_EtatVBA1_2 '!!!! A activer pour le xla !!!!
If Wb.Name = ThisWorkbook.Name Then Exit Sub
'Cette condition permet de lancer le code que si d'autres fichiers ne sont pas actuellement ouvert.
'En effet, comme l'événement "WorkbookDeactivate" va désactiver un fichier déjà ouvert, "WorkbookActivate"
'sera appelé pour se fichier tout de suite après.
If Workbooks.Count = 1 Then Call AppSuiviX_WorkbookActivate(Wb)
End Sub

Private Sub AppSuiviX_WorkbookActivate(ByVal Wb As Workbook)
Dim CtlDelModuleMenu As CommandBarControl, CtlDelModulePopUp As CommandBarControl
Dim Test As String
On Error Resume Next
Test = Wb.Sheets("SuiviX>>HistCell").Name
If Err.Number = 0 Then
  SuiviCellNon = False
  If Application.CutCopyMode = 0 Then Call P_InitVariables(Wb.ActiveSheet): Call P_InitVarOp
  '############# détection coupe/copie cellule #############
  If Application.CutCopyMode <> 0 Then Call VarCutCopy
Else
  SuiviCellNon = True
  If Application.CutCopyMode = 0 Then Set PlageSel = Selection:  AutreClasseur = ActiveWorkbook.Name & "." & ActiveWorkbook.ActiveSheet.Name
End If
On Error GoTo 0
If ActiveWorkbook.VBProject.Protection = vbext_pp_locked Then
  MsgBox "Le code VBA de ce fichier est protégé! processus interrompu.", vbCritical, "SuiviVBA"
  Exit Sub
End If
Call P_EtatVBA1_2

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>> Gestion suppression module dans VBE >>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Set CtlDelModuleMenu = Application.VBE.CommandBars(1).Controls(1).Controls(8)
Set CtlDelModulePopUp = Application.VBE.CommandBars(14).Controls(8)
Set EvntDelModuleMenu = Application.VBE.Events.CommandBarEvents(CtlDelModuleMenu)
Set EvntDelModulePopUp = Application.VBE.Events.CommandBarEvents(CtlDelModulePopUp)
End Sub

Private Sub EvntDelModuleMenu_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
Dim g As Byte, d As Byte, NomVBE As String
With Application.VBE
  g = InStr(1, .MainWindow.Caption, "-") + 2
  d = InStr(1, .MainWindow.Caption, "[") - 2
  NomVBE = Mid(.MainWindow.Caption, g, d - g + 1)
  If NomVBE <> ActiveWorkbook.Name Then
    CancelDefault = True
    MsgBox "Il faut sélectionnez un module du fichier actif: " & ActiveWorkbook.Name, vbExclamation, "Suppression de module"
  ElseIf SuiviVBAOui(ActiveWorkbook) Then
    Call P_DeleteModule(.SelectedVBComponent)
    CancelDefault = True
    Application.ScreenUpdating = True 'sinon excel ne s'affiche pas correctement
  End If
End With
End Sub

Private Sub EvntDelModulePopUp_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
Dim g As Byte, d As Byte, NomVBE As String
With Application.VBE
  g = InStr(1, .MainWindow.Caption, "-") + 2
  d = InStr(1, .MainWindow.Caption, "[") - 2
  NomVBE = Mid(.MainWindow.Caption, g, d - g + 1)
  If NomVBE <> ActiveWorkbook.Name Then
    CancelDefault = True
    MsgBox "Il faut sélectionnez un module du fichier actif: " & ActiveWorkbook.Name, vbExclamation, "Suppression de module"
  ElseIf SuiviVBAOui(ActiveWorkbook) Then
    Call P_DeleteModule(.SelectedVBComponent)
    CancelDefault = True
    Application.ScreenUpdating = True 'sinon excel ne s'affiche pas correctement
  End If
End With
End Sub
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>> Gestion suppression module dans VBE >>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Private Sub AppSuiviX_SheetActivate(ByVal Sh As Object)
'If SuiviCellNon Then Exit Sub
If SuiviCellNon And Application.CutCopyMode = 0 Then
  Set PlageSel = Selection
  AutreClasseur = ActiveWorkbook.Name & "." & Sh.Name
ElseIf Not SuiviCellNon Then
  '############# détection coupe/copie cellule #############
  If Not SuiviFeuilNon(Sh) And Application.CutCopyMode <> 0 And Not NomSh Like "SuiviX>>Hist*" Then
    Call VarCutCopy
  Else: AutreClasseur = ""
  End If
  '############# détection format de feuille ###########
  'pour détecter la suppression/création d'une feuille et la sauvegarde car sinon est écrit 2 fois dans la feuille de suivi
  If Not SuiviFeuilNon(Sh) And NbSh = ActiveWorkbook.Sheets.Count And Not SaveDetect And Not NomSh Like "SuiviX>>Hist*" And Not PlageSel Is Nothing Then Call FormatCell: Call CommentCell: Call FusCell
  '############# détection opération de feuille ###########
  'on vérifie que la feuille de suivi VBA n'a pas été créée
  If Not AjoutShVBA Then
    Call OperationsFeuil
  Else: AjoutShVBA = False
  End If
  If Not SuiviCellNon Then Call P_FeuilSuiviPleine("SuiviX>>HistCell", 50, ActiveWorkbook)
  If Application.CutCopyMode = 0 Then Call P_InitVariables(Sh)
  SaveDetect = False: DetectDeplace = 0
  'on initialise l'état opération de feuille
  OpSh = ""
End If
End Sub

Private Sub AppSuiviX_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As Long
If SuiviCellNon Then Exit Sub
If SuiviFeuilNon(Sh) Or Sh.Name Like "SuiviX>>Hist*" Then Exit Sub
Application.EnableEvents = False
'############# détection coupe/copie de cellule(s) ###########
'coupe/colle
If ModeCutCopy = 2 Then
  Call MajHistCColle("coupe/colle cellule(s)")
'copie/colle
ElseIf ModeCutCopy = 1 Then
  Call MajHistCColle("copie/colle cellule(s)")
Else
  Set PlageSel = Selection
  NbLig = Selection.Rows.Count
  NbCol = Selection.Columns.Count
'############# intervention sur ligne ###########
  If Selection.Count = Sh.Rows(Selection.Row).Columns.Count * NbLig Then
    'ici, permet de voir qu'il s'agit d'une insertion
    If Sh.UsedRange.Cells(Sh.UsedRange.Count).Row > DerLig Then
      Call MajHist1(OpInsSupLigCol, "insertion ligne", NomSh, Selection.Address(0, 0))
    'ici, permet de voir qu'il s'agit d'une suppression
    ElseIf Sh.UsedRange.Cells(Sh.UsedRange.Count).Row < DerLig Then
      Call MajHist1(OpInsSupLigCol, "suppression ligne", NomSh, Selection.Address(0, 0))
    End If
'############# intervention sur colonne ############
  ElseIf Selection.Count = Sh.Columns(Selection.Column).Rows.Count * NbCol Then
    'ici, permet de voir qu'il s'agit d'une insertion
    If Sh.UsedRange.Cells(Sh.UsedRange.Count).Column > DerCol Then
      Call MajHist1(OpInsSupLigCol, "insertion colonne", NomSh, Selection.Address(0, 0))
    'ici, permet de voir qu'il s'agit d'une suppression
    ElseIf Sh.UsedRange.Cells(Sh.UsedRange.Count).Column < DerCol Then
      Call MajHist1(OpInsSupLigCol, "suppression colonne", NomSh, Selection.Address(0, 0))
    End If
  Else
'############# intervention sur 1 cellule ############
'Cette variable permet de détecter un déplacement de cellule(s) car celà déclenche l'événement "Change"
'2 fois de suite puis l'événement "Selection"
    DetectDeplace = DetectDeplace + 1
    If Target.Count = 1 Then
    'détection de insertion/suppression d'une plage de cellules avec décalage
      Call DetecInsSuppCell(Sh)
    'sinon opération sur les cellules:
      If LastChange <> "I" And LastChange <> "S" Then
        If Target.Count = Selection.Count Then
          If IsEmpty(Target.Value) And Not IsEmpty(TempValue) Then
            Call MajHist1(True, "Cellule vidée", NomSh, Target.Address(0, 0), "<vide>", IIf(TempValue Like "=*", "'" & TempValue, TempValue))
          ElseIf Target.HasFormula Or TempValue Like "=*" Then
            If Target.FormulaLocal <> TempValue Then
              Call MajHist1(True, "Cellule modifiée", NomSh, Target.Address(0, 0), "'" & Target.FormulaLocal, IIf(IsEmpty(TempValue), "<vide>", "'" & TempValue))
            End If
          ElseIf Target.Value <> TempValue Then
            Call MajHist1(True, "Cellule modifiée", NomSh, Target.Address(0, 0), Target.Value, IIf(IsEmpty(TempValue), "<vide>", TempValue))
          End If
      'Détection déplacement de la cellule
          If DetectDeplace = 2 Then
            With ActiveWorkbook.Sheets("SuiviX>>HistCell")
              Call MajHist1(True, "Déplacement de cellule", NomSh, .[C2].Value & " vers " & Target.Address(0, 0), IIf(Target.HasFormula, "'" & Target.FormulaLocal, Target.Value), "<inconnu>")
              DetectDeplace = 0
              .Range("A3:H3").Delete shift:=xlShiftUp
            End With
          End If
    'La donnée est auto remplie:
        ElseIf Target.Count <> Selection.Count Then
          Call MajHist1(True, "Cellule auto-remplie", NomSh, Target.Address(0, 0), IIf(Target.HasFormula, "'" & Target.FormulaLocal, Target.Value), "<inconnu>")
        End If
      End If
'############# intervention sur plusieurs cellules ############
    ElseIf Target.Count > 1 Then
    'détection de insertion/suppression d'une plage de cellules avec décalage
      Call DetecInsSuppCell(Sh)
    'sinon opération sur les cellules:
      If LastChange <> "I" And LastChange <> "S" Then
        If PlageSel.Address = Selection.Address Then
          LastChange = "R"
          If Target.Count = Selection.Count Then
            For i = 1 To Target.Count
              If IsEmpty(Target(i).Value) And Not IsEmpty(ListTemp(i)) Then
                Call MajHist1(True, "Cellule vidée", NomSh, Target(i).Address(0, 0), "<vide>", IIf(ListTemp(i) Like "=*", "'" & ListTemp(i), ListTemp(i)))
              ElseIf Target(i).HasFormula Or ListTemp(i) Like "=*" Then
                If Target(i).FormulaLocal <> ListTemp(i) Then
                  Call MajHist1(True, "Cellule modifiée", NomSh, Target(i).Address(0, 0), "'" & Target(i).FormulaLocal, IIf(IsEmpty(ListTemp(i)), "<vide>", "'" & ListTemp(i)))
                End If
              ElseIf Target(i).Value <> ListTemp(i) Then
                Call MajHist1(True, "Cellule modifiée", NomSh, Target(i).Address(0, 0), Target(i).Value, IIf(IsEmpty(ListTemp(i)), "<vide>", ListTemp(i)))
              End If
            Next
          End If
      'Détection déplacement des cellules
          If DetectDeplace = 2 Then
            With ActiveWorkbook.Sheets("SuiviX>>HistCell")
              For i = 1 To Target.Count
                Call MajHist1(True, "Déplacement de cellule", NomSh, .Range("C" & 1 + Target.Count).Value & " vers " & Target(i).Address(0, 0), IIf(Target(i).HasFormula, "'" & Target(i).FormulaLocal, Target(i).Value), "<inconnu>")
              Next
              .Range("A" & Target.Count + 2 & ":H" & Target.Count * 2 + 1).Delete shift:=xlShiftUp
            End With
            DetectDeplace = 0
      'Les données sont auto remplies:
          ElseIf Target.Count <> Selection.Count Then
            For i = 1 To Target.Count
              Call MajHist1(True, "Cellule auto-remplie", NomSh, Target(i).Address(0, 0), IIf(Target(i).HasFormula, "'" & Target(i).FormulaLocal, Target(i).Value), "<inconnu>")
            Next
          End If
        End If
      End If
    End If
  End If
End If
If Not SuiviCellNon Then Call P_FeuilSuiviPleine("SuiviX>>HistCell", 500, ActiveWorkbook)
ModeCutCopy = 0
Application.CutCopyMode = 0
Call P_InitVariables(Sh)
Application.EnableEvents = True
End Sub

Private Sub AppSuiviX_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'If SuiviCellNon Then Exit Sub
If SuiviCellNon And Application.CutCopyMode = 0 Then
  Set PlageSel = Selection
  AutreClasseur = ActiveWorkbook.Name & "." & Sh.Name
ElseIf Not SuiviCellNon Then
  'on met la procédure d'opérations de feuille au cas où on fait des modifications dans cette feuille
  'après un renommage de cette dernière.
  '############# détection opération de feuille ###########
  'on vérifie que la feuille de suivi VBA n'a pas été créée
  If Not AjoutShVBA Then
    Call OperationsFeuil
  Else: AjoutShVBA = False
  End If
  If SuiviFeuilNon(Sh) Or Sh.Name Like "SuiviX>>Hist*" Then Exit Sub
  '############# détection coupe/copie cellule #############
  If Application.CutCopyMode <> 0 Then
    Call VarCutCopy
  Else
    AutreClasseur = ""
    '############# modifications formats de cellules ############
    If LastChange <> "I" And LastChange <> "S" And Not SaveDetect Then Call FormatCell
    If Not SaveDetect Then
      Call CommentCell: Call FusCell
    End If
  'on vérifie si toute les feuilles ont été sélectionnées -> message
    If Target.Count = Cells.Count Then
      MsgBox "SuiviX ne gère pas toutes les cellules de la feuille!", vbExclamation, "SuiviX"
      Sh.[A1].Select
    Else
    '"P_InitVariables" déplacé ici car en mode coupe/copie, si la cellule de déstination n'est choisi qu'au bout de la
    '2eme sélection, cela ne va plus.
      Call P_InitVariables(Sh)
    End If
  End If
  If Not SuiviCellNon Then Call P_FeuilSuiviPleine("SuiviX>>HistCell", 50, ActiveWorkbook)
  LastChange = "": DetectDeplace = 0
  Application.EnableEvents = False: SaveDetect = False
  NbLig = Selection.Rows.Count: NbCol = Selection.Columns.Count
  DerLig = Sh.UsedRange.Cells(Sh.UsedRange.Count).Row: DerCol = Sh.UsedRange.Cells(Sh.UsedRange.Count).Column
  'Call P_InitVariables(Sh)
  'on initialise l'état opération de feuille
  OpSh = ""
  Application.EnableEvents = True
End If
End Sub

Private Function SuiviFeuilNon(Feuil As Worksheet) As Boolean
Dim Pos As Integer
With ActiveWorkbook
  On Error Resume Next
  Pos = WorksheetFunction.Match(Feuil.Name, .Sheets("SuiviX>>HistCell").Range("J2:J" & .Sheets("SuiviX>>HistCell").[J65536].End(xlUp).Row), 0)
  If Err.Number > 0 And Not Feuil.Name Like "SuiviX>>Hist*" And Not .Sheets("SuiviX>>HistCell").[M2] Then SuiviFeuilNon = True
  On Error GoTo 0
End With
End Function

Private Sub VarCutCopy()
Dim i As Long
If PlageSel.Count = 1 Then
  AdressCutCopy = PlageSel.Address(0, 0)
  ReDim ListCutCopy(1 To 1): ListCutCopy(1) = PlageSel.Address(0, 0)
Else
  ReDim ListCutCopy(1 To PlageSel.Count)
  For i = 1 To PlageSel.Count
    ListCutCopy(i) = PlageSel(i).Address(0, 0)
  Next
End If
'AutreClasseur = ""
ModeCutCopy = Application.CutCopyMode
Debug.Print ModeCutCopy
End Sub

Private Sub DetecInsSuppCell(Feuille As Worksheet)
  Dim Test As String
  On Error Resume Next
  'détection de insertion/suppression d'une plage de cellules avec décalage horizontal
  Test = CellD.Address
  If Err.Number > 0 Then
    On Error GoTo 0
    LastChange = "I"
    Call MajHist1(OpInsSupCel, "insertion cellule, décalage droite", Feuille.Name, Selection.Address(0, 0))
  ElseIf CellD.Column < 256 Then
    LastChange = "S"
    Set NewSel = Selection(1)
    Call MajHist1(OpInsSupCel, "suppression cellule ,décalage gauche", Feuille.Name, Selection.Address(0, 0))
  Else
  'détection de insertion/suppression d'une plage de cellules avec décalage vertical
    On Error Resume Next
    Test = CellB.Address
    If Err.Number > 0 Then
      On Error GoTo 0
      LastChange = "I"
      Call MajHist1(OpInsSupCel, "insertion cellule, décalage bas", Feuille.Name, Selection.Address(0, 0))
    ElseIf CellB.Row < 65536 Then
    LastChange = "S"
    Set NewSel = Selection(1)
      Call MajHist1(OpInsSupCel, "suppression cellule, décalage haut", Feuille.Name, Selection.Address(0, 0))
  'si pas d'insertion/suppression de cellule(s)
    Else: LastChange = ""
    End If
  End If
End Sub

'############# commentaires de cellules ############
Private Sub CommentCell()
'la condition permet de prendre en compte un renommage de feuille
'suivi d'un changement de format sur la cellule active.
  If Not PlageSel.Comment Is Nothing Then
  'si ajout
    If TextComment = "" Then
      Call MajHist1(OpCommentCel, "ajout commentaire cellule", IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh), PlageSel.Address(0, 0), PlageSel.Comment.Text, "<vide>")
  'si modification
    ElseIf TextComment <> PlageSel.Comment.Text Then
      Call MajHist1(OpCommentCel, "modification commentaire cellule", IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh), PlageSel.Address(0, 0), PlageSel.Comment.Text, TextComment)
    End If
  'si suppression
  ElseIf TextComment <> "" And PlageSel(1).Comment Is Nothing Then
    Call MajHist1(OpCommentCel, "suppression commentaire cellule", IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh), PlageSel.Address(0, 0), "<vide>", TextComment)
  End If
End Sub

'############# cellules fusionnées ############
Private Sub FusCell()
'la condition permet de prendre en compte un renommage de feuille
'suivi d'un changement de format sur la cellule active.
'cellules fusionnées
  If (PlageFus = False And PlageSel.MergeCells) Or (IsNull(PlageFus) And PlageSel.MergeCells) Then
    Call MajHist1(OpFusCel, "cellules fusionnées", IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh), PlageSel.Address(0, 0))
'cellules dé-fusionnées
  ElseIf (PlageFus = True And Not PlageSel.MergeCells) Or (IsNull(PlageFus) And Not PlageSel.MergeCells) Then
    Call MajHist1(OpFusCel, "cellules dé-fusionnées", IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh), PlageSel.Address(0, 0))
  End If
End Sub

Private Sub MajHist1(OpSuivi As Boolean, OpName As String, Feuil As String, OpAdresse As String, Optional NCont As Variant, Optional ACont As Variant)
If Not OpSuivi Then Exit Sub
With ActiveWorkbook.Sheets("SuiviX>>HistCell")
  If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
  .Range("A2").Value = OpName
  .Range("B2").Value = Feuil
  .Range("C2").Value = "'" & OpAdresse
  If Not IsMissing(NCont) Then .Range("D2").Value = NCont
  If Not IsMissing(ACont) Then .Range("E2").Value = ACont
  Call P_AutDaTi("SuiviX>>HistCell")
End With
End Sub

Private Sub MajHistCColle(OpName As String)
Dim i As Long, x As Long, Lig As Long, Col As Long, LastLig As Long
If Not OpCColle Then Exit Sub
With ActiveWorkbook.Sheets("SuiviX>>HistCell")
'Si une cellule de déstination
  If Selection.Count = 1 Then
    If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
    .Range("A2").Value = OpName
'    .Range("B2").Value = IIf(NomSh <> ActiveWorkbook.ActiveSheet.Name, NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name, NomSh)
    If AutreClasseur <> "" Then
      .Range("B2").Value = AutreClasseur & " vers " & ActiveWorkbook.ActiveSheet.Name
    ElseIf NomSh <> ActiveWorkbook.ActiveSheet.Name Then
      .Range("B2").Value = NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name
    Else: .Range("B2").Value = NomSh
    End If
    .Range("C2").Value = AdressCutCopy & " vers " & Selection.Address(0, 0)
    Selection.Copy .Range("D2")
    If Selection.HasFormula Then .Range("D2").Value = "'" & Selection.FormulaLocal
    .Range("E2").Value = "<inconnu>"
    Call P_AutDaTi("SuiviX>>HistCell")
'Si plusieurs cellules de déstination
  Else
  'Si le nbre des cellules de déstination sont égal aux cellules sources
    If Selection.Count = PlageSel.Count Then
      For i = 1 To Selection.Count
        If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
        .Range("A2").Value = OpName
'        .Range("B2").Value = IIf(NomSh <> ActiveWorkbook.ActiveSheet.Name, NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name, NomSh)
        If AutreClasseur <> "" Then
          .Range("B2").Value = AutreClasseur & " vers " & ActiveWorkbook.ActiveSheet.Name
        ElseIf NomSh <> ActiveWorkbook.ActiveSheet.Name Then
          .Range("B2").Value = NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name
        Else: .Range("B2").Value = NomSh
        End If
        .Range("C2").Value = ListCutCopy(i) & " vers " & Selection(i).Address(0, 0)
        Selection(i).Copy .Range("D2")
        If Selection(i).HasFormula Then .Range("D2").Value = "'" & Selection(i).FormulaLocal
        .Range("E2").Value = "<inconnu>"
        Call P_AutDaTi("SuiviX>>HistCell")
      Next
  'Si le nbre des cellules de déstination sont supérieures aux cellules sources
    Else
    'Si le nbre de colonnes de cellules déstination sont <= aux nbre de colonnes de cellules sources
      If Selection.Columns.Count <= PlageSel.Columns.Count Then
        x = 0
        Do
          For i = 1 To PlageSel.Count
            x = x + 1
            If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
            .Range("A2").Value = OpName
'            .Range("B2").Value = IIf(NomSh <> ActiveWorkbook.ActiveSheet.Name, NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name, NomSh)
            If AutreClasseur <> "" Then
              .Range("B2").Value = AutreClasseur & " vers " & ActiveWorkbook.ActiveSheet.Name
            ElseIf NomSh <> ActiveWorkbook.ActiveSheet.Name Then
              .Range("B2").Value = NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name
            Else: .Range("B2").Value = NomSh
            End If
            .Range("C2").Value = ListCutCopy(i) & " vers " & Selection(x).Address(0, 0)
            Selection(i).Copy .Range("D2")
            If Selection(x).HasFormula Then .Range("D2").Value = "'" & Selection(x).FormulaLocal
            .Range("E2").Value = "<inconnu>"
            Call P_AutDaTi("SuiviX>>HistCell")
          Next
        Loop Until x = Selection.Count
    'Si le nbre de colonnes de cellules déstination sont > aux nbre de colonnes de cellules sources
      ElseIf Selection.Columns.Count > PlageSel.Columns.Count Then
        x = 1
        Do
          For Lig = 1 To PlageSel.Rows.Count
            Do
              For Col = 1 To PlageSel.Columns.Count
                LastLig = Selection(x).Row
                If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
                .Range("A2").Value = OpName
'                .Range("B2").Value = IIf(NomSh <> ActiveWorkbook.ActiveSheet.Name, NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name, NomSh)
                If AutreClasseur <> "" Then
                  .Range("B2").Value = AutreClasseur & " vers " & ActiveWorkbook.ActiveSheet.Name
                ElseIf NomSh <> ActiveWorkbook.ActiveSheet.Name Then
                  .Range("B2").Value = NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name
                Else: .Range("B2").Value = NomSh
                End If
                .Range("C2").Value = PlageSel(Lig, Col).Address(0, 0) & " vers " & Selection(x).Address(0, 0)
                PlageSel(Lig, Col).Copy .Range("D2")
                If Selection(x).HasFormula Then .Range("D2").Value = "'" & Selection(x).FormulaLocal
                .Range("E2").Value = "<inconnu>"
                Call P_AutDaTi("SuiviX>>HistCell")
                x = x + 1
              Next
            Loop While LastLig = Selection(x).Row
          Next
        Loop Until x > Selection.Count
      End If
    End If
  End If
End With
AutreClasseur = ""
End Sub

Private Sub FormatCell()
Dim Texte As String
With ActiveWorkbook.Sheets("SuiviX>>HistCell")
'-------- opération couleur de fond ---------
  If OpCoulFond Then
    If CoulFond <> PlageSel.Interior.ColorIndex Or (IsNull(CoulFond) And Not IsNull(PlageSel.Interior.ColorIndex)) Then
      If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
      .Range("D2").Interior.ColorIndex = PlageSel.Interior.ColorIndex
      If Not IsNull(CoulFond) Then
        .Range("E2").Interior.ColorIndex = CoulFond
      Else: .Range("E2").Value = "<multiple couleur de fond>"
      End If
      Texte = "couleur de fond,"
    End If
  End If
'-------- opération couleur de police ---------
  If OpCoulPol Then
    If CoulPolice <> PlageSel.Font.ColorIndex Or (IsNull(CoulPolice) And Not IsNull(PlageSel.Font.ColorIndex)) Then
      If Texte = "" Then
        If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
      End If
      .Range("D2").Font.ColorIndex = PlageSel.Font.ColorIndex: .Range("D2").Value = "<nouvelle couleur>"
      If Not IsNull(CoulPolice) Then
        .Range("E2").Font.ColorIndex = CoulPolice: .Range("E2").Value = "<ancienne couleur>"
      Else: .Range("E2").Value = .Range("E2").Value & "<multiple couleur police>"
      End If
      Texte = Texte & "couleur police,"
    End If
  End If
'-------- MAJ feuille de suivi ---------
  If Texte <> "" Then
    Texte = Left(Texte, Len(Texte) - 1)
    .Range("A2").Value = Texte
  'la condition permet de prendre en compte un renommage de feuille
  'suivi d'un changement de format sur la cellule active.
    .Range("B2").Value = IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh)
    .Range("C2").Value = PlageSel.Address(0, 0)
    Texte = ""
    Call P_AutDaTi("SuiviX>>HistCell")
  End If
End With
End Sub

Private Sub OperationsFeuil()
Dim NewListSh() As Variant, PosSh As Long
Application.EnableEvents = False
'on initialise l'état
OpSh = ""
'on écrit la nouvelle disposition dans NewListSh
With ActiveWorkbook
  ReDim NewListSh(1 To .Sheets.Count)
  For i = 1 To .Sheets.Count
    NewListSh(i) = .Sheets(i).Name
  Next
  '---------- détection création de feuille ----------
  If .Sheets.Count > NbSh Then
    OpSh = "c"
    Call MajHist1(OpFeuil, "Création feuille", .ActiveSheet.Name & " devant " & NomSh, "")
  '---------- détection suppression de feuille ----------
  ElseIf .Sheets.Count < NbSh Then
    'on vérifie si la feuille de suivi "SuiviX>>HistCell" a été supprimé, dans ce cas on repasse "SuiviCellNon" à vrai
    If NomSh = "SuiviX>>HistCell" Then
      SuiviCellNon = True
      Application.EnableEvents = True
      Exit Sub
    End If
    OpSh = "s"
    Call MajHist1(OpFeuil, "Suppression feuille", NomSh, "")
    Set PlageSel = Nothing
  Else
  '---------- renommage de feuille ----------
    'si le nom stocké dans la variable NomSh n'est pas trouvé dans la nouvelle disposition (NewListSh),
    'alors il s'agit d'un renommage.
    On Error Resume Next
    PosSh = WorksheetFunction.Match(NomSh, NewListSh, 0)
    If Err.Number > 0 Then
      On Error GoTo 0
  'on cherche la position de la feuille renommée au cas où elle a également été déplacée!
  'de la nouvelle liste NewListSh dans l'ancienne liste ListSh
      For i = LBound(NewListSh) To UBound(NewListSh)
        On Error Resume Next
        PosSh = WorksheetFunction.Match(NewListSh(i), ListSh, 0)
        If Err.Number > 0 Then
          ISh = i
          Exit For
        End If
      Next
      OpSh = "r"
      Call MajHist1(OpFeuil, "Renommage feuille", NomSh & " en " & .Sheets(ISh).Name, "")
    'on vérifie que la feuille est suivi pour les opérations de cellule pour mettre à jour la feuille Hist si nécessaire
      On Error GoTo 0
      On Error Resume Next
      PosSh = WorksheetFunction.Match(NomSh, .Sheets("SuiviX>>HistCell").Range("J2:J" & .Sheets("SuiviX>>HistCell").[J65536].End(xlUp).Row), 0)
      If Err.Number = 0 Then
        On Error GoTo 0
        .Sheets("SuiviX>>HistCell").Range("J" & PosSh + 1).Value = .Sheets(ISh).Name
      End If
     'on met à jour les variables au cas où la feuille a également été déplacée!
      NomSh = .Sheets(ISh).Name
      ListSh(ISh) = NomSh
    End If
    On Error GoTo 0
  End If
  '---------- déplacement de feuille ----------
  If OpSh <> "s" And OpSh <> "c" Then
    For i = 1 To .Sheets.Count
      If .Sheets(i).Name <> ListSh(i) Then
        'on cherche l'emplacement de la feuille
          PosSh = WorksheetFunction.Match(NomSh, NewListSh, 0)
          If PosSh < .Sheets.Count Then
            Call MajHist1(OpFeuil, "Déplacement feuille", NomSh & " devant " & .Sheets(PosSh + 1).Name, "")
          Else: Call MajHist1(OpFeuil, "Déplacement feuille", NomSh & " en dernier", "")
          End If
        Exit For
      End If
    Next
  End If
'---------- ATTENTION -------------
'La MAJ variables ce fait dans les procédures qui appelent ce code, en tenir compte au cas où
End With
Application.EnableEvents = True
End Sub

Test et dis-moi.

dasporto · 27 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Bonjour Skoobi,

Le problème précédent a été résolu, serieusement magnifique.

J’ai encore un petit défi pour toi.

Je vais te donner un exemple :

J’ouvre le classeur « Suivi » j’ouvre la feuille « SuiviX>>HistCell », après j’ouvre un autre classeur où je copie de D1

5 de la feuille 1. Je reviens sur le classeur « Suivi » et je pointe sur D1 sur la feuille 1 et je colle.

Lorsque je vais voir dans la feuille « SuiviX>>HistCell »dans la colonne Feuille(s) Concernée(s) il y a :
SuiviX>>HistCell vers Feuille1

Autre exemple, j’ouvre le classeur « Suivi » j’ouvre la feuille1, après j’ouvre un autre classeur où je copie de D1

5 de la feuille 1. Je reviens sur le classeur « Suivi », je suis déjà sur la feuille 1 je pointe sur D1 et je colle.

Cette fois-ci lorsque je vais voir dans la feuille « SuiviX>>HistCell »dans la colonne Feuille(s) Concernée(s) il y a :
Classeur1.Feuille1 vers Feuille1, là c’est correct.

J’espère que c’est compréhensible mon explication.

As-tu le même phénomène ? Si oui as-tu une solution?

Une autre petite question :

Lorsqu’on fait un copie/colle la colonne ancien contenu indique <inconnu> y a-t-il une solution pour cela aussi.

En espérant que je ne suis pas trop chiant.
Merci de ton aide et bon courage.
Dasporto.

dasporto · 27 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Re Skoobi,

Si jamais remplace

par : D

Dasporto

skoobi · 28 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Bonjour dasporto,

pour le 1er problème, c'est réglé.

dasporto à dit:
Lorsqu’on fait un copie/colle la colonne ancien contenu indique <inconnu> y a-t-il une solution pour cela aussi.
Dasporto.

Je mettais <inconnu>, oui je dis bien mettais

, car je n'avais pas de solution à l'origine. Mais lorsque l'on n'a plus la tête dans le guidon, les idées surviennent

. Même chose, remplace le code "Thisworkbook".

Code:

'---------------------------------------------------------------------------------------
' Titre     : SuiviX
' Auteur    : Skoobi
' Date      : 27/04/2010
' Sujet     : Suivi des modifications des cellules, feuilles et codes VBA
'---------------------------------------------------------------------------------------
'++++++++ déclarations gestion cellule +++++++++
Dim DerLig As Long, DerCol As Long
Dim Lig As Long, Col As Long, PlageAddress As String, StateUndo As Boolean, UndoDo As Boolean
Dim LastChange As String
Dim NewSel As Range, ModeCutCopy As Byte, AdressCutCopy As String
Dim ListCutCopy() As Variant, StopFormat As Boolean
Dim SaveDetect As Boolean, DetectDeplace As Byte, OpSh As String, CloseDetect As Boolean
Dim XLAInstalled As Boolean
Dim AutreClasseur As String
Dim ListDest() As Variant 'v2.21

Private WithEvents AppSuiviX As Application
'Permet de détecter la suppression de module via le menu ou clic droit pour avertir l'utilisateur
Private WithEvents EvntDelModuleMenu As CommandBarEvents, WithEvents EvntDelModulePopUp As CommandBarEvents

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&& Partie gestion du fichier SuiviX.xla &&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Private Sub Workbook_Open()

'vérifie que le fichier est installé et non ouvert comme un fichier ordinaire
Set AppSuiviX = Application
On Error Resume Next
XLAInstalled = AddIns("SuiviX_v2.1").Installed
If Err.Number > 0 Then
  MsgBox "Ce fichier est une macro complémentaire à installer via Outils>Macros complémentaire", vbCritical
  ThisWorkbook.Close
  Exit Sub
End If
'création des menus et contrôles
Call P_InitMenu
SuiviCellNon = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call P_DelMenu
End Sub

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& Partie gestion des fichiers ouverts &&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

Private Sub AppSuiviX_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If Wb.Name = ThisWorkbook.Name Then Exit Sub '!!!! A activer pour le xla !!!!
CloseDetect = True
End Sub

Private Sub AppSuiviX_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Wb.Name = ThisWorkbook.Name Then Exit Sub ' !!!! A activer pour le xla !!!!
'############# met à jour la feuille de suivi VBA si actif ###########
If SuiviVBAOui(Wb) Then
  Set WbX = Wb
  Call P_VBACompare
  Call P_FeuilSuiviPleine("SuiviX>>HistVBA", 2000, Wb)
End If
'############# met à jour la feuille de suivi cellule si actif ###########
If SuiviCellNon Then Exit Sub
'############# détection format de feuille ###########
If NbSh = Wb.Sheets.Count And Not NomSh Like "SuiviX>>Hist*" Then  'pour détecter la suppression/création d'une feuille
  Call FormatCell: Call CommentCell: Call FusCell
  SaveDetect = True
End If
'############# détection opération de feuille ###########
Call OperationsFeuil
If Not SuiviCellNon Then Call P_FeuilSuiviPleine("SuiviX>>HistCell", 500, Wb)
End Sub

Private Sub AppSuiviX_WorkbookDeactivate(ByVal Wb As Workbook)
If CloseDetect Then
  CloseDetect = False
  Exit Sub
End If
'Si on effectue une modification de code et que l'on active un autre fichier, "WorkbookDeactivate"
'fait la mise à jour dans la feuille de suivi avant de passer à cet autre fichier.
If SuiviVBAOui(Wb) Then
  Set WbX = Wb
  Call P_VBACompare
  Call P_FeuilSuiviPleine("SuiviX>>HistVBA", 2000, Wb)
End If
End Sub

Private Sub AppSuiviX_WorkbookOpen(ByVal Wb As Workbook)
'La condition suivante permet de tout de suite prendre en charge le suiviVBA du fichier actif lors de l'installation
'de l'utilitaire (pas nécessaire de fermer et ouvrir ce fichier).
If Not XLAInstalled And Wb.Name = ThisWorkbook.Name Then Call P_EtatVBA1_2 '!!!! A activer pour le xla !!!!
If Wb.Name = ThisWorkbook.Name Then Exit Sub
'Cette condition permet de lancer le code que si d'autres fichiers ne sont pas actuellement ouvert.
'En effet, comme l'événement "WorkbookDeactivate" va désactiver un fichier déjà ouvert, "WorkbookActivate"
'sera appelé pour se fichier tout de suite après.
If Workbooks.Count = 1 Then Call AppSuiviX_WorkbookActivate(Wb)
End Sub

Private Sub AppSuiviX_WorkbookActivate(ByVal Wb As Workbook)
Dim CtlDelModuleMenu As CommandBarControl, CtlDelModulePopUp As CommandBarControl
Dim Test As String
On Error Resume Next
Test = Wb.Sheets("SuiviX>>HistCell").Name
If Err.Number = 0 Then
  SuiviCellNon = False
  If Application.CutCopyMode = 0 Then Call P_InitVariables(Wb.ActiveSheet): Call P_InitVarOp
  '############# détection coupe/copie cellule #############
  If Application.CutCopyMode <> 0 Then Call VarCutCopy
Else
  SuiviCellNon = True
  If Application.CutCopyMode = 0 Then
    Set PlageSel = Selection
    AutreClasseur = ActiveWorkbook.Name & "." & ActiveWorkbook.ActiveSheet.Name
  End If
End If
On Error GoTo 0
If ActiveWorkbook.VBProject.Protection = vbext_pp_locked Then
  MsgBox "Le code VBA de ce fichier est protégé! processus interrompu.", vbCritical, "SuiviVBA"
  Exit Sub
End If
Call P_EtatVBA1_2

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>> Gestion suppression module dans VBE >>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Set CtlDelModuleMenu = Application.VBE.CommandBars(1).Controls(1).Controls(8)
Set CtlDelModulePopUp = Application.VBE.CommandBars(14).Controls(8)
Set EvntDelModuleMenu = Application.VBE.Events.CommandBarEvents(CtlDelModuleMenu)
Set EvntDelModulePopUp = Application.VBE.Events.CommandBarEvents(CtlDelModulePopUp)
End Sub

Private Sub EvntDelModuleMenu_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
Dim g As Byte, d As Byte, NomVBE As String
With Application.VBE
  g = InStr(1, .MainWindow.Caption, "-") + 2
  d = InStr(1, .MainWindow.Caption, "[") - 2
  NomVBE = Mid(.MainWindow.Caption, g, d - g + 1)
  If NomVBE <> ActiveWorkbook.Name Then
    CancelDefault = True
    MsgBox "Il faut sélectionnez un module du fichier actif: " & ActiveWorkbook.Name, vbExclamation, "Suppression de module"
  ElseIf SuiviVBAOui(ActiveWorkbook) Then
    Call P_DeleteModule(.SelectedVBComponent)
    CancelDefault = True
    Application.ScreenUpdating = True 'sinon excel ne s'affiche pas correctement
  End If
End With
End Sub

Private Sub EvntDelModulePopUp_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
Dim g As Byte, d As Byte, NomVBE As String
With Application.VBE
  g = InStr(1, .MainWindow.Caption, "-") + 2
  d = InStr(1, .MainWindow.Caption, "[") - 2
  NomVBE = Mid(.MainWindow.Caption, g, d - g + 1)
  If NomVBE <> ActiveWorkbook.Name Then
    CancelDefault = True
    MsgBox "Il faut sélectionnez un module du fichier actif: " & ActiveWorkbook.Name, vbExclamation, "Suppression de module"
  ElseIf SuiviVBAOui(ActiveWorkbook) Then
    Call P_DeleteModule(.SelectedVBComponent)
    CancelDefault = True
    Application.ScreenUpdating = True 'sinon excel ne s'affiche pas correctement
  End If
End With
End Sub
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>> Gestion suppression module dans VBE >>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Private Sub AppSuiviX_SheetActivate(ByVal Sh As Object)
'If SuiviCellNon Then Exit Sub
If SuiviCellNon And Application.CutCopyMode = 0 Then
  Set PlageSel = Selection
  AutreClasseur = ActiveWorkbook.Name & "." & Sh.Name
ElseIf Not SuiviCellNon Then
  '############# détection coupe/copie cellule #############
  If Not SuiviFeuilNon(Sh) And Application.CutCopyMode <> 0 And Not NomSh Like "SuiviX>>Hist*" Then
    Call VarCutCopy
'  Else: AutreClasseur = ""
  ElseIf Application.CutCopyMode = 0 Then
    AutreClasseur = ""
  End If
  '############# détection format de feuille ###########
  'pour détecter la suppression/création d'une feuille et la sauvegarde car sinon est écrit 2 fois dans la feuille de suivi
  If Not SuiviFeuilNon(Sh) And NbSh = ActiveWorkbook.Sheets.Count And Not SaveDetect And Not NomSh Like "SuiviX>>Hist*" And Not PlageSel Is Nothing Then Call FormatCell: Call CommentCell: Call FusCell
  '############# détection opération de feuille ###########
  'on vérifie que la feuille de suivi VBA n'a pas été créée
  If Not AjoutShVBA Then
    Call OperationsFeuil
  Else: AjoutShVBA = False
  End If
  If Not SuiviCellNon Then Call P_FeuilSuiviPleine("SuiviX>>HistCell", 50, ActiveWorkbook)
  If Application.CutCopyMode = 0 Then Call P_InitVariables(Sh)
  SaveDetect = False: DetectDeplace = 0
  'on initialise l'état opération de feuille
  OpSh = ""
End If
End Sub

Private Sub AppSuiviX_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i As Long
If SuiviCellNon Then Exit Sub
If SuiviFeuilNon(Sh) Or Sh.Name Like "SuiviX>>Hist*" Then Exit Sub
Application.EnableEvents = False
'############# détection coupe/copie de cellule(s) ###########
'coupe/colle
If ModeCutCopy = 2 Then
  Call MajHistCColle("coupe/colle cellule(s)")
'copie/colle
ElseIf ModeCutCopy = 1 Then
  Call MajHistCColle("copie/colle cellule(s)")
Else
  Set PlageSel = Selection
  NbLig = Selection.Rows.Count
  NbCol = Selection.Columns.Count
'############# intervention sur ligne ###########
  If Selection.Count = Sh.Rows(Selection.Row).Columns.Count * NbLig Then
    'ici, permet de voir qu'il s'agit d'une insertion
    If Sh.UsedRange.Cells(Sh.UsedRange.Count).Row > DerLig Then
      Call MajHist1(OpInsSupLigCol, "insertion ligne", NomSh, Selection.Address(0, 0))
    'ici, permet de voir qu'il s'agit d'une suppression
    ElseIf Sh.UsedRange.Cells(Sh.UsedRange.Count).Row < DerLig Then
      Call MajHist1(OpInsSupLigCol, "suppression ligne", NomSh, Selection.Address(0, 0))
    End If
'############# intervention sur colonne ############
  ElseIf Selection.Count = Sh.Columns(Selection.Column).Rows.Count * NbCol Then
    'ici, permet de voir qu'il s'agit d'une insertion
    If Sh.UsedRange.Cells(Sh.UsedRange.Count).Column > DerCol Then
      Call MajHist1(OpInsSupLigCol, "insertion colonne", NomSh, Selection.Address(0, 0))
    'ici, permet de voir qu'il s'agit d'une suppression
    ElseIf Sh.UsedRange.Cells(Sh.UsedRange.Count).Column < DerCol Then
      Call MajHist1(OpInsSupLigCol, "suppression colonne", NomSh, Selection.Address(0, 0))
    End If
  Else
'############# intervention sur 1 cellule ############
'Cette variable permet de détecter un déplacement de cellule(s) car celà déclenche l'événement "Change"
'2 fois de suite puis l'événement "Selection"
    DetectDeplace = DetectDeplace + 1
    If Target.Count = 1 Then
    'détection de insertion/suppression d'une plage de cellules avec décalage
      Call DetecInsSuppCell(Sh)
    'sinon opération sur les cellules:
      If LastChange <> "I" And LastChange <> "S" Then
        If Target.Count = Selection.Count Then
          If IsEmpty(Target.Value) And Not IsEmpty(TempValue) Then
            Call MajHist1(True, "Cellule vidée", NomSh, Target.Address(0, 0), "<vide>", IIf(TempValue Like "=*", "'" & TempValue, TempValue))
          ElseIf Target.HasFormula Or TempValue Like "=*" Then
            If Target.FormulaLocal <> TempValue Then
              Call MajHist1(True, "Cellule modifiée", NomSh, Target.Address(0, 0), "'" & Target.FormulaLocal, IIf(IsEmpty(TempValue), "<vide>", "'" & TempValue))
            End If
          ElseIf Target.Value <> TempValue Then
            Call MajHist1(True, "Cellule modifiée", NomSh, Target.Address(0, 0), Target.Value, IIf(IsEmpty(TempValue), "<vide>", TempValue))
          End If
      'Détection déplacement de la cellule
          If DetectDeplace = 2 Then
            With ActiveWorkbook.Sheets("SuiviX>>HistCell")
              Call MajHist1(True, "Déplacement de cellule", NomSh, .[C2].Value & " vers " & Target.Address(0, 0), IIf(Target.HasFormula, "'" & Target.FormulaLocal, Target.Value), "<inconnu>")
              DetectDeplace = 0
              .Range("A3:H3").Delete shift:=xlShiftUp
            End With
          End If
    'La donnée est auto remplie:
        ElseIf Target.Count <> Selection.Count Then
          Call MajHist1(True, "Cellule auto-remplie", NomSh, Target.Address(0, 0), IIf(Target.HasFormula, "'" & Target.FormulaLocal, Target.Value), "<inconnu>")
        End If
      End If
'############# intervention sur plusieurs cellules ############
    ElseIf Target.Count > 1 Then
    'détection de insertion/suppression d'une plage de cellules avec décalage
      Call DetecInsSuppCell(Sh)
    'sinon opération sur les cellules:
      If LastChange <> "I" And LastChange <> "S" Then
        If PlageSel.Address = Selection.Address Then
          LastChange = "R"
          If Target.Count = Selection.Count Then
            For i = 1 To Target.Count
              If IsEmpty(Target(i).Value) And Not IsEmpty(ListTemp(i)) Then
                Call MajHist1(True, "Cellule vidée", NomSh, Target(i).Address(0, 0), "<vide>", IIf(ListTemp(i) Like "=*", "'" & ListTemp(i), ListTemp(i)))
              ElseIf Target(i).HasFormula Or ListTemp(i) Like "=*" Then
                If Target(i).FormulaLocal <> ListTemp(i) Then
                  Call MajHist1(True, "Cellule modifiée", NomSh, Target(i).Address(0, 0), "'" & Target(i).FormulaLocal, IIf(IsEmpty(ListTemp(i)), "<vide>", "'" & ListTemp(i)))
                End If
              ElseIf Target(i).Value <> ListTemp(i) Then
                Call MajHist1(True, "Cellule modifiée", NomSh, Target(i).Address(0, 0), Target(i).Value, IIf(IsEmpty(ListTemp(i)), "<vide>", ListTemp(i)))
              End If
            Next
          End If
      'Détection déplacement des cellules
          If DetectDeplace = 2 Then
            With ActiveWorkbook.Sheets("SuiviX>>HistCell")
              For i = 1 To Target.Count
                Call MajHist1(True, "Déplacement de cellule", NomSh, .Range("C" & 1 + Target.Count).Value & " vers " & Target(i).Address(0, 0), IIf(Target(i).HasFormula, "'" & Target(i).FormulaLocal, Target(i).Value), "<inconnu>")
              Next
              .Range("A" & Target.Count + 2 & ":H" & Target.Count * 2 + 1).Delete shift:=xlShiftUp
            End With
            DetectDeplace = 0
      'Les données sont auto remplies:
          ElseIf Target.Count <> Selection.Count Then
            For i = 1 To Target.Count
              Call MajHist1(True, "Cellule auto-remplie", NomSh, Target(i).Address(0, 0), IIf(Target(i).HasFormula, "'" & Target(i).FormulaLocal, Target(i).Value), "<inconnu>")
            Next
          End If
        End If
      End If
    End If
  End If
End If
If Not SuiviCellNon Then Call P_FeuilSuiviPleine("SuiviX>>HistCell", 500, ActiveWorkbook)
ModeCutCopy = 0
Application.CutCopyMode = 0
Call P_InitVariables(Sh)
Application.EnableEvents = True
End Sub

Private Sub AppSuiviX_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'If SuiviCellNon Then Exit Sub
If SuiviCellNon And Application.CutCopyMode = 0 Then
  Set PlageSel = Selection
  AutreClasseur = ActiveWorkbook.Name & "." & Sh.Name
ElseIf Not SuiviCellNon Then
  'on met la procédure d'opérations de feuille au cas où on fait des modifications dans cette feuille
  'après un renommage de cette dernière.
  '############# détection opération de feuille ###########
  'on vérifie que la feuille de suivi VBA n'a pas été créée
  If Not AjoutShVBA Then
    Call OperationsFeuil
  Else: AjoutShVBA = False
  End If
  If SuiviFeuilNon(Sh) Or Sh.Name Like "SuiviX>>Hist*" Then Exit Sub
  '############# détection coupe/copie cellule #############
  If Application.CutCopyMode <> 0 Then
    Call VarCutCopy
  Else
    AutreClasseur = ""
    '############# modifications formats de cellules ############
    If LastChange <> "I" And LastChange <> "S" And Not SaveDetect Then Call FormatCell
    If Not SaveDetect Then
      Call CommentCell: Call FusCell
    End If
  'on vérifie si toute les feuilles ont été sélectionnées -> message
    If Target.Count = Cells.Count Then
      MsgBox "SuiviX ne gère pas toutes les cellules de la feuille!", vbExclamation, "SuiviX"
      Sh.[A1].Select
    Else
    '"P_InitVariables" déplacé ici car en mode coupe/copie, si la cellule de déstination n'est choisi qu'au bout de la
    '2eme sélection, cela ne va plus.
      Call P_InitVariables(Sh)
    End If
  End If
  If Not SuiviCellNon Then Call P_FeuilSuiviPleine("SuiviX>>HistCell", 50, ActiveWorkbook)
  LastChange = "": DetectDeplace = 0
  Application.EnableEvents = False: SaveDetect = False
  NbLig = Selection.Rows.Count: NbCol = Selection.Columns.Count
  DerLig = Sh.UsedRange.Cells(Sh.UsedRange.Count).Row: DerCol = Sh.UsedRange.Cells(Sh.UsedRange.Count).Column
  'Call P_InitVariables(Sh)
  'on initialise l'état opération de feuille
  OpSh = ""
  Application.EnableEvents = True
End If
End Sub

Private Function SuiviFeuilNon(Feuil As Worksheet) As Boolean
Dim Pos As Integer
With ActiveWorkbook
  On Error Resume Next
  Pos = WorksheetFunction.Match(Feuil.Name, .Sheets("SuiviX>>HistCell").Range("J2:J" & .Sheets("SuiviX>>HistCell").[J65536].End(xlUp).Row), 0)
  If Err.Number > 0 And Not Feuil.Name Like "SuiviX>>Hist*" And Not .Sheets("SuiviX>>HistCell").[M2] Then SuiviFeuilNon = True
  On Error GoTo 0
End With
End Function

Private Sub VarCutCopy()
Dim i As Long, j As Long
Dim nCol As Long, nLig As Long 'v2.21
If PlageSel.Count = 1 Then
  ReDim ListDest(1 To 1) 'v2.21
  ListDest(1) = IIf(Selection.HasFormula, "'" & Selection.FormulaLocal, Selection.Value) 'v2.21
  AdressCutCopy = PlageSel.Address(0, 0)
  ReDim ListCutCopy(1 To 1): ListCutCopy(1) = PlageSel.Address(0, 0)
Else
  If Selection.Count <= PlageSel.Count Then 'v2.21
    nCol = PlageSel.Columns.Count 'v2.21
    nLig = PlageSel.Rows.Count 'v2.21
    ReDim ListDest(1 To Selection.Resize(nLig, nCol).Count) 'v2.21
    For i = 1 To Selection.Resize(nLig, nCol).Count 'v2.21
      ListDest(i) = IIf(Selection.Resize(nLig, nCol)(i).HasFormula, "'" & Selection.Resize(nLig, nCol)(i).FormulaLocal, Selection.Resize(nLig, nCol)(i).Value) 'v2.21
    Next 'v2.21
  Else 'v2.21
    ReDim ListDest(1 To Selection.Count) 'v2.21
    For i = 1 To Selection.Count 'v2.21
      ListDest(i) = IIf(Selection(i).HasFormula, "'" & Selection(i).FormulaLocal, Selection(i).Value) 'v2.21
    Next 'v2.21
  End If 'v2.21
  ReDim ListCutCopy(1 To PlageSel.Count)
  For i = 1 To PlageSel.Count
    ListCutCopy(i) = PlageSel(i).Address(0, 0)
  Next
End If
ModeCutCopy = Application.CutCopyMode
End Sub

Private Sub DetecInsSuppCell(Feuille As Worksheet)
  Dim Test As String
  On Error Resume Next
  'détection de insertion/suppression d'une plage de cellules avec décalage horizontal
  Test = CellD.Address
  If Err.Number > 0 Then
    On Error GoTo 0
    LastChange = "I"
    Call MajHist1(OpInsSupCel, "insertion cellule, décalage droite", Feuille.Name, Selection.Address(0, 0))
  ElseIf CellD.Column < 256 Then
    LastChange = "S"
    Set NewSel = Selection(1)
    Call MajHist1(OpInsSupCel, "suppression cellule ,décalage gauche", Feuille.Name, Selection.Address(0, 0))
  Else
  'détection de insertion/suppression d'une plage de cellules avec décalage vertical
    On Error Resume Next
    Test = CellB.Address
    If Err.Number > 0 Then
      On Error GoTo 0
      LastChange = "I"
      Call MajHist1(OpInsSupCel, "insertion cellule, décalage bas", Feuille.Name, Selection.Address(0, 0))
    ElseIf CellB.Row < 65536 Then
    LastChange = "S"
    Set NewSel = Selection(1)
      Call MajHist1(OpInsSupCel, "suppression cellule, décalage haut", Feuille.Name, Selection.Address(0, 0))
  'si pas d'insertion/suppression de cellule(s)
    Else: LastChange = ""
    End If
  End If
End Sub

'############# commentaires de cellules ############
Private Sub CommentCell()
'la condition permet de prendre en compte un renommage de feuille
'suivi d'un changement de format sur la cellule active.
  If Not PlageSel.Comment Is Nothing Then
  'si ajout
    If TextComment = "" Then
      Call MajHist1(OpCommentCel, "ajout commentaire cellule", IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh), PlageSel.Address(0, 0), PlageSel.Comment.Text, "<vide>")
  'si modification
    ElseIf TextComment <> PlageSel.Comment.Text Then
      Call MajHist1(OpCommentCel, "modification commentaire cellule", IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh), PlageSel.Address(0, 0), PlageSel.Comment.Text, TextComment)
    End If
  'si suppression
  ElseIf TextComment <> "" And PlageSel(1).Comment Is Nothing Then
    Call MajHist1(OpCommentCel, "suppression commentaire cellule", IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh), PlageSel.Address(0, 0), "<vide>", TextComment)
  End If
End Sub

'############# cellules fusionnées ############
Private Sub FusCell()
'la condition permet de prendre en compte un renommage de feuille
'suivi d'un changement de format sur la cellule active.
'cellules fusionnées
  If (PlageFus = False And PlageSel.MergeCells) Or (IsNull(PlageFus) And PlageSel.MergeCells) Then
    Call MajHist1(OpFusCel, "cellules fusionnées", IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh), PlageSel.Address(0, 0))
'cellules dé-fusionnées
  ElseIf (PlageFus = True And Not PlageSel.MergeCells) Or (IsNull(PlageFus) And Not PlageSel.MergeCells) Then
    Call MajHist1(OpFusCel, "cellules dé-fusionnées", IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh), PlageSel.Address(0, 0))
  End If
End Sub

Private Sub MajHist1(OpSuivi As Boolean, OpName As String, Feuil As String, OpAdresse As String, Optional NCont As Variant, Optional ACont As Variant)
If Not OpSuivi Then Exit Sub
With ActiveWorkbook.Sheets("SuiviX>>HistCell")
  If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
  .Range("A2").Value = OpName
  .Range("B2").Value = Feuil
  .Range("C2").Value = "'" & OpAdresse
  If Not IsMissing(NCont) Then .Range("D2").Value = NCont
  If Not IsMissing(ACont) Then .Range("E2").Value = ACont
  Call P_AutDaTi("SuiviX>>HistCell")
End With
End Sub

Private Sub MajHistCColle(OpName As String)
Dim i As Long, x As Long, Lig As Long, Col As Long, LastLig As Long
If Not OpCColle Then Exit Sub
With ActiveWorkbook.Sheets("SuiviX>>HistCell")
'Si une cellule de déstination
  If Selection.Count = 1 Then
    If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
    .Range("A2").Value = OpName
'    .Range("B2").Value = IIf(NomSh <> ActiveWorkbook.ActiveSheet.Name, NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name, NomSh)
    If AutreClasseur <> "" Then
      .Range("B2").Value = AutreClasseur & " vers " & ActiveWorkbook.ActiveSheet.Name
    ElseIf NomSh <> ActiveWorkbook.ActiveSheet.Name Then
      .Range("B2").Value = NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name
    Else: .Range("B2").Value = NomSh
    End If
    .Range("C2").Value = AdressCutCopy & " vers " & Selection.Address(0, 0)
    Selection.Copy .Range("D2")
    If Selection.HasFormula Then .Range("D2").Value = "'" & Selection.FormulaLocal
'    .Range("E2").Value = "<inconnu>"
    .Range("E2").Value = ListDest(1) 'v2.21
    Call P_AutDaTi("SuiviX>>HistCell")
'Si plusieurs cellules de déstination
  Else
  'Si le nbre des cellules de déstination est égal aux nbre de cellules sources
    If Selection.Count = PlageSel.Count Then
      For i = 1 To Selection.Count
        If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
        .Range("A2").Value = OpName
'        .Range("B2").Value = IIf(NomSh <> ActiveWorkbook.ActiveSheet.Name, NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name, NomSh)
        If AutreClasseur <> "" Then
          .Range("B2").Value = AutreClasseur & " vers " & ActiveWorkbook.ActiveSheet.Name
        ElseIf NomSh <> ActiveWorkbook.ActiveSheet.Name Then
          .Range("B2").Value = NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name
        Else: .Range("B2").Value = NomSh
        End If
        .Range("C2").Value = ListCutCopy(i) & " vers " & Selection(i).Address(0, 0)
        Selection(i).Copy .Range("D2")
        If Selection(i).HasFormula Then .Range("D2").Value = "'" & Selection(i).FormulaLocal
'        .Range("E2").Value = "<inconnu>"
        .Range("E2").Value = ListDest(i) 'v2.21
        Call P_AutDaTi("SuiviX>>HistCell")
      Next
  'Si le nbre des cellules de déstination sont supérieures aux cellules sources
    Else
    'Si le nbre de colonnes de cellules déstination sont <= aux nbre de colonnes de cellules sources
      If Selection.Columns.Count <= PlageSel.Columns.Count Then
        x = 0
        Do
          For i = 1 To PlageSel.Count
            x = x + 1
            If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
            .Range("A2").Value = OpName
'            .Range("B2").Value = IIf(NomSh <> ActiveWorkbook.ActiveSheet.Name, NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name, NomSh)
            If AutreClasseur <> "" Then
              .Range("B2").Value = AutreClasseur & " vers " & ActiveWorkbook.ActiveSheet.Name
            ElseIf NomSh <> ActiveWorkbook.ActiveSheet.Name Then
              .Range("B2").Value = NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name
            Else: .Range("B2").Value = NomSh
            End If
            .Range("C2").Value = ListCutCopy(i) & " vers " & Selection(x).Address(0, 0)
            Selection(i).Copy .Range("D2")
            If Selection(x).HasFormula Then .Range("D2").Value = "'" & Selection(x).FormulaLocal
'            .Range("E2").Value = "<inconnu>"
            .Range("E2").Value = ListDest(x) 'v2.21
            Call P_AutDaTi("SuiviX>>HistCell")
          Next
        Loop Until x = Selection.Count
    'Si le nbre de colonnes de cellules déstination sont > aux nbre de colonnes de cellules sources
      ElseIf Selection.Columns.Count > PlageSel.Columns.Count Then
        x = 1
        Do
          For Lig = 1 To PlageSel.Rows.Count
            Do
              For Col = 1 To PlageSel.Columns.Count
                LastLig = Selection(x).Row
                If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
                .Range("A2").Value = OpName
'                .Range("B2").Value = IIf(NomSh <> ActiveWorkbook.ActiveSheet.Name, NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name, NomSh)
                If AutreClasseur <> "" Then
                  .Range("B2").Value = AutreClasseur & " vers " & ActiveWorkbook.ActiveSheet.Name
                ElseIf NomSh <> ActiveWorkbook.ActiveSheet.Name Then
                  .Range("B2").Value = NomSh & " vers " & ActiveWorkbook.ActiveSheet.Name
                Else: .Range("B2").Value = NomSh
                End If
                .Range("C2").Value = PlageSel(Lig, Col).Address(0, 0) & " vers " & Selection(x).Address(0, 0)
                PlageSel(Lig, Col).Copy .Range("D2")
                If Selection(x).HasFormula Then .Range("D2").Value = "'" & Selection(x).FormulaLocal
'                .Range("E2").Value = "<inconnu>"
                .Range("E2").Value = ListDest(x) 'v2.21
                Call P_AutDaTi("SuiviX>>HistCell")
                x = x + 1
              Next
            Loop While LastLig = Selection(x).Row
          Next
        Loop Until x > Selection.Count
      End If
    End If
  End If
End With
AutreClasseur = ""
End Sub

Private Sub FormatCell()
Dim Texte As String
With ActiveWorkbook.Sheets("SuiviX>>HistCell")
'-------- opération couleur de fond ---------
  If OpCoulFond Then
    If CoulFond <> PlageSel.Interior.ColorIndex Or (IsNull(CoulFond) And Not IsNull(PlageSel.Interior.ColorIndex)) Then
      If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
      .Range("D2").Interior.ColorIndex = PlageSel.Interior.ColorIndex
      If Not IsNull(CoulFond) Then
        .Range("E2").Interior.ColorIndex = CoulFond
      Else: .Range("E2").Value = "<multiple couleur de fond>"
      End If
      Texte = "couleur de fond,"
    End If
  End If
'-------- opération couleur de police ---------
  If OpCoulPol Then
    If CoulPolice <> PlageSel.Font.ColorIndex Or (IsNull(CoulPolice) And Not IsNull(PlageSel.Font.ColorIndex)) Then
      If Texte = "" Then
        If Not IsEmpty(.Range("A2").Value) Then .Range("A2:H2").Insert: .Range("A2:H2").Clear
      End If
      .Range("D2").Font.ColorIndex = PlageSel.Font.ColorIndex: .Range("D2").Value = "<nouvelle couleur>"
      If Not IsNull(CoulPolice) Then
        .Range("E2").Font.ColorIndex = CoulPolice: .Range("E2").Value = "<ancienne couleur>"
      Else: .Range("E2").Value = .Range("E2").Value & "<multiple couleur police>"
      End If
      Texte = Texte & "couleur police,"
    End If
  End If
'-------- MAJ feuille de suivi ---------
  If Texte <> "" Then
    Texte = Left(Texte, Len(Texte) - 1)
    .Range("A2").Value = Texte
  'la condition permet de prendre en compte un renommage de feuille
  'suivi d'un changement de format sur la cellule active.
    .Range("B2").Value = IIf(OpSh = "r" And NameSh <> NomSh, NomSh, NameSh)
    .Range("C2").Value = PlageSel.Address(0, 0)
    Texte = ""
    Call P_AutDaTi("SuiviX>>HistCell")
  End If
End With
End Sub

Private Sub OperationsFeuil()
Dim NewListSh() As Variant, PosSh As Long
Application.EnableEvents = False
'on initialise l'état
OpSh = ""
'on écrit la nouvelle disposition dans NewListSh
With ActiveWorkbook
  ReDim NewListSh(1 To .Sheets.Count)
  For i = 1 To .Sheets.Count
    NewListSh(i) = .Sheets(i).Name
  Next
  '---------- détection création de feuille ----------
  If .Sheets.Count > NbSh Then
    OpSh = "c"
    Call MajHist1(OpFeuil, "Création feuille", .ActiveSheet.Name & " devant " & NomSh, "")
  '---------- détection suppression de feuille ----------
  ElseIf .Sheets.Count < NbSh Then
    'on vérifie si la feuille de suivi "SuiviX>>HistCell" a été supprimé, dans ce cas on repasse "SuiviCellNon" à vrai
    If NomSh = "SuiviX>>HistCell" Then
      SuiviCellNon = True
      Application.EnableEvents = True
      Exit Sub
    End If
    OpSh = "s"
    Call MajHist1(OpFeuil, "Suppression feuille", NomSh, "")
    Set PlageSel = Nothing
  Else
  '---------- renommage de feuille ----------
    'si le nom stocké dans la variable NomSh n'est pas trouvé dans la nouvelle disposition (NewListSh),
    'alors il s'agit d'un renommage.
    On Error Resume Next
    PosSh = WorksheetFunction.Match(NomSh, NewListSh, 0)
    If Err.Number > 0 Then
      On Error GoTo 0
  'on cherche la position de la feuille renommée au cas où elle a également été déplacée!
  'de la nouvelle liste NewListSh dans l'ancienne liste ListSh
      For i = LBound(NewListSh) To UBound(NewListSh)
        On Error Resume Next
        PosSh = WorksheetFunction.Match(NewListSh(i), ListSh, 0)
        If Err.Number > 0 Then
          ISh = i
          Exit For
        End If
      Next
      OpSh = "r"
      Call MajHist1(OpFeuil, "Renommage feuille", NomSh & " en " & .Sheets(ISh).Name, "")
    'on vérifie que la feuille est suivi pour les opérations de cellule pour mettre à jour la feuille Hist si nécessaire
      On Error GoTo 0
      On Error Resume Next
      PosSh = WorksheetFunction.Match(NomSh, .Sheets("SuiviX>>HistCell").Range("J2:J" & .Sheets("SuiviX>>HistCell").[J65536].End(xlUp).Row), 0)
      If Err.Number = 0 Then
        On Error GoTo 0
        .Sheets("SuiviX>>HistCell").Range("J" & PosSh + 1).Value = .Sheets(ISh).Name
      End If
     'on met à jour les variables au cas où la feuille a également été déplacée!
      NomSh = .Sheets(ISh).Name
      ListSh(ISh) = NomSh
    End If
    On Error GoTo 0
  End If
  '---------- déplacement de feuille ----------
  If OpSh <> "s" And OpSh <> "c" Then
    For i = 1 To .Sheets.Count
      If .Sheets(i).Name <> ListSh(i) Then
        'on cherche l'emplacement de la feuille
          PosSh = WorksheetFunction.Match(NomSh, NewListSh, 0)
          If PosSh < .Sheets.Count Then
            Call MajHist1(OpFeuil, "Déplacement feuille", NomSh & " devant " & .Sheets(PosSh + 1).Name, "")
          Else: Call MajHist1(OpFeuil, "Déplacement feuille", NomSh & " en dernier", "")
          End If
        Exit For
      End If
    Next
  End If
'---------- ATTENTION -------------
'La MAJ variables ce fait dans les procédures qui appelent ce code, en tenir compte au cas où
End With
Application.EnableEvents = True
End Sub

En espérant que je ne suis pas trop chiant.

Au contraire dasporto, l'intérêt que tu portes à mon utilitaire le fait évoluer et je t'en remercie

.
J'ai plus qu'à mettre à jour le fichier xla pour créer la nouvelle version.
Ah non, c'est vrai, je dois attendre ta prochaine remarque

.

Bon test

vbavba · 29 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Bonjour Scoobi!
Tout d'abord merci beaucoup pour cet outil que j'ai hâte d'essayer

en fait, je suis sur Excel2007 et je n'arrive pas à installer le SuiviX_v2.xla.
j'obtiens le message d'erreur suivant:

Erreur d'exécution '1004':
La méthode 'VBE' de l'objet '_Application' a échoué

et quand je clique débogage, j'ai ça:

Sub P_EtatVBA2_2(SuivrecodeVBADispo As Boolean, VBACompareDispo As Boolean, NettoyerHistVBADispo As Boolean, DelModVBADispo As Boolean)
With Application.VBE.CommandBars(1).Controls("SuiviX") .Controls("Suivre code VBA").Enabled = SuivrecodeVBADispo
.Controls("Comparer code VBA").Enabled = VBACompareDispo
.Controls("Nettoyer HistVBA").Enabled = NettoyerHistVBADispo
End With
End Sub

Pourrais-tu stp me dire comment résoudre ce problème?
D'avance merci,

dasporto · 29 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Bonjour vbavba,

Va dans le bouton office puis Option d'excel puis Trust Center puis paramètres Trust Center puis coche la case tout en bas.

C'est possible que les termes que je t'ai donnés ne pas les memes j'ai la version anglaise.

Dasporto.

vbavba · 29 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Bonjour Dasporto,

j'ai fait la manip mais ça n'a pas résoulu le problème.
j'ai toujours le même message d'erreur et le problème est toujours dans la ligne que j'avais surlignée en Jaune dans mon ancien post.

Autres propositions?
D'avance merci,

dasporto · 29 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Re vbavba,

As-tu lu les explications dans le document word joint au .xla.
Il te demande de cocher une case dans visual basic > outils > references.

Dasporto

vbavba · 29 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

ça marche!! merci beaucoup Dasporto

il fallait juste cocher une case dans la partie "sécurité de macros" sous Excel.

dasporto · 29 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Bonjour Skoobi,

Tout d’abord bravo pour tes modifs elles fonctionnent à merveille. Vu que tu es friand de mes remarques je t’en ai préparé 4 faisable ou non je te les énonce. Dans les exemples suivants je röutilisent souvent les memes cellules mais y’a aucun lien.

1) Entrons B10=1 B11=2 B12=7 B13=8 B14=9, je sélectionne B10 et B11 puis je fais glisser vers B14 pour créer un collage en glissant, dans ce cas créer une suite. Allons voir maintenant la feuille « SuiviX>>HistCell » il y a bien B12 =3 B13=4 B14=5 mais les anciens contenus n’apparaissent pas.

2) Entrons B10=7 B11=8 B12=9, lorsque je copie B10, B10 est donc en surbrillance alors je double-clique sur B11 comme si je voulais la remplir (B10 ne brille plus) ensuite je clique sur B12 pour désélectionner B11. Allons voir maintenant la feuille « SuiviX>>HistCell » on a bien copie/colle de B10 vers B12 avec comme nouveau contenu 9 et comme ancien contenu 8 alors que je n’ai strictement rien changé. (ce problême sera je pense dificille).

3) Imaginons B10 en Bleu (couleur de fond) et B11 en Jaune, je clique sur B10 et je fais copie puis je pointe sur B11 et je fais collage special en cochant format. Allons voir maintenant la feuille « SuiviX>>HistCell » le format du nouveau contenu apparait mais pas celui de l’ancien contenu.

4) Entrons B20=1 avec le commentaire « Salut » et B21=2 avec le commentaire « toi », je fais un copie sur B20 et un collage special commentaire sur B21. Allons voir maintenant la feuille « SuiviX>>HistCell » on lit copie/colle de B20 vers B21, nouveau contenu de valeur 2 avec le commentaire « Salut » et l’ancien contenu de valeur 2 sans commentaire.

Voila c’est tout et bon courage.

Dasporto.

skoobi · 29 Avril 2010

Re : SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

Re,

1): je n'ai pas de solution à cela, malheureusement.
2, 3 et 4: visiblement tu aimes bien le collage spécial

. Je n'ai pour l'instant pas pris ce genre d'opérations en compte, il y a tellement de choix possible...
J'en prends note mais cela fera l'objet d'une future version qui demandera surement une modification lourde dans le code, et je n'ai pas le temps en ce moment. Je vais déjà faire le nouveau xla avec les quelques nouveautés.

Encore merci pour tes tests et remarques dasporto

.

Effectuez une recherche sur Excel Downloads...

SuiviX: suivi des opérations sur les cellules, feuillles et code VBA

dasporto

XLDnaute Nouveau

dasporto

XLDnaute Nouveau

skoobi

XLDnaute Barbatruc

dasporto

XLDnaute Nouveau

skoobi

XLDnaute Barbatruc

dasporto

XLDnaute Nouveau

dasporto

XLDnaute Nouveau

skoobi

XLDnaute Barbatruc

vbavba

XLDnaute Nouveau

dasporto

XLDnaute Nouveau

vbavba

XLDnaute Nouveau

dasporto

XLDnaute Nouveau

vbavba

XLDnaute Nouveau

dasporto

XLDnaute Nouveau

skoobi

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums