Comment faire un journal externe à l'aide de VBA Excel?

Le problème est que lorsque vous entrez les cellules fusionnées, la valeur de mise en PreviousValue (en Worksheet_SelectionChange) est un tableau de toutes les cellules fusionnées, ce qui vous ne pouvez pas comparer à la nouvelle valeur. Lorsque Worksheet_Change est tiré sur l'édition, la cible est seulement la partie supérieure gauche de la cellule de la fusion de gamme. Donc, nous allons simplement suivre que des cellules fusionnées plages. Remplacer votre Worksheet_SelectionChange avec les éléments suivants:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    PreviousValue = Target(1).Value
End Sub

Avertissement: Cela a été testé sur Excel pour Mac 2011 que je n'ai pas accès à Excel pour Windows pour le moment, mais je suis assez sûr qu'elle fonctionne sur Excel pour Windows.

OriginalL'auteur Jason Clark

un an plus tard, j'ai modifié le Code de Matthieu - maintenant, il suit les modifications apportées par copier/coller ou à traquer les souris aussi, merci Matthieu pour la bonne idée!:

'Paste this into a Module:
Option Explicit
'SheetArray to hold the old values before any change is made
Public aSheetArr() As Variant
'helperfunctions for last row and last col of a given sheet:
Function LastRow(sh As Worksheet)
'get last row of a given worksheet
sh.EnableAutoFilter = False
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
'get last col of a given worksheet
sh.EnableAutoFilter = False
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
'Paste this into the workbook_Open method of your workbook (initializing the sheetarray)
Option Explicit
Private Sub Workbook_Open()
Dim lCol As Long
Dim lRow As Long
Dim wks As Worksheet
Set wks = Sheets(1)
lCol = LastCol(wks)
lRow = LastRow(wks)
aSheetArr = wks.Range(wks.Cells(1, 1), wks.Cells(lRow, lCol)) 'read the Range from the whole Sheet into the array
End Sub
'Paste this into the tablemodule - area where you want to log the changes:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'logging all the changes in a worksheet - also the copy/past's and track down's over ceveral cells
Dim sLogFileName As String, nFileNum As Long, sLogMessage As String, r As Long
sLogFileName = ThisWorkbook.Path & Application.PathSeparator & "Log.txt"
'Check all cells for changes, excluding D4 D5 E5 M1 etc
For r = 1 To Target.Count
'compare each cell with the values from the old cell
If Target(r).value <> aSheetArr(Target(r).Row, Target(r).Column) Then
' Check if we have an error
If Err.Number = 13 Then
PreviousValue(r) = 0
End If
' Turn off error handling
'On Error GoTo 0
'log data into .txt file
sLogMessage = Now & " " & Application.UserName & " changed cell " & Target(r).Address _
& " in " & ActiveSheet.Name & " from " & "'" & aSheetArr(Target(r).Row, Target(r).Column) & "' to '" & Target(r).value & "'"
'set the values in the array to the changed ones
aSheetArr(Target(r).Row, Target(r).Column) = Target(r).value
nFileNum = FreeFile ' next file number
Open sLogFileName For Append As #nFileNum ' create the file if it doesn't exist
Print #nFileNum, sLogMessage ' append information
Close #nFileNum ' close the file
End If
Next r
End Sub

OriginalL'auteur OtisLoomgard