Tengo un código para registrar el uso en una hoja de Excel, pero obtengo un error y un problema

Este es un sistema de logging universal, que unas pocas personas aquí y yo hemos creado. Estoy bastante orgulloso de ello … Me encuentro con dos problemas … si alguien puede ayudar con la solución, será genial.

Aquí está el código:

Option Explicit Dim PreviousValue Private Sub Worksheet_Change(ByVal Target As Range) Dim sLogFileName As String, nFileNum As Long, sLogMessage As String sLogFileName = ThisWorkbook.path & Application.PathSeparator & "Log.txt" On Error Resume Next ' Turn on error handling If Target.Value <> PreviousValue Then ' Check if we have an error If Err.Number = 13 Then PreviousValue = 0 End If ' Turn off error handling On Error GoTo 0 sLogMessage = Now & Application.UserName & " changed cell " & Target.Address _ & " from " & PreviousValue & " to " & Target.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 End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) PreviousValue = Target(1).Value End Sub 

Aquí están los dos problemas.

  1. Si se selecciona más de una celda e intenta escribirse, el script se equivoca.
  2. Si alguien edita una celda y la deja en blanco, se mostrará el 8/30/2012 1:45:01 PM Matthew Ridge changed cell $K$3 from Test to lugar de 8/30/2012 1:45:01 PM Matthew Ridge changed cell $K$3 from Test to Blank or Empty

Mate

Pocas cosas

  1. On Error Resume Next no es el manejo correcto. Debe evitarse a less y hasta que sea absolutamente necesario.
  2. Cuando trabaje con el evento Worksheet_Change , es mejor desactivar los events y luego volverlos a activar al final para evitar posibles loops sin fin.
  3. Si está desactivando events, es imprescindible que utilice el manejo adecuado de errores.
  4. Dado que está almacenando solo una celda en el valor PreviousValue supongo que no desea que el código se ejecute cuando el usuario selecciona varias celdas.

Creo que esto es lo que estás intentando ( NO PROBADO )?

 Option Explicit Dim PreviousValue Private Sub Worksheet_Change(ByVal Target As Range) Dim sLogFileName As String, nFileNum As Long, sLogMessage As String Dim NewVal On Error GoTo Whoa Application.EnableEvents = False sLogFileName = ThisWorkbook.Path & Application.PathSeparator & "Log.txt" If Not Target.Cells.Count > 1 Then If Target.Value <> PreviousValue Then If Len(Trim(Target.Value)) = 0 Then _ NewVal = "Blank" Else NewVal = Target.Value sLogMessage = Now & Application.UserName & _ " changed cell " & Target.Address & " from " & _ PreviousValue & " to " & NewVal nFileNum = FreeFile Open sLogFileName For Append As #nFileNum Print #nFileNum, sLogMessage Close #nFileNum End If End If LetsContinue: Application.EnableEvents = True Exit Sub Whoa: MsgBox Err.Description Resume LetsContinue End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) PreviousValue = Target(1).Value End Sub 

Esto funcionó para mí. Lo ideal es que tenga un range con nombre en la hoja que se rastrea, que puede utilizar para restringir el seguimiento solo a los cambios que se producen dentro de ese range.

 Const MAX_TRACKED_CELLS As Long = 50 Dim PreviousValues As Object Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range Dim haveDict As Boolean, val, addr haveDict = Not PreviousValues Is Nothing If Target.Cells.Count <= MAX_TRACKED_CELLS Then For Each c In Target.Cells addr = c.Address() If haveDict Then If PreviousValues.exists(addr) Then val = PreviousValues(addr) End If Else val = "{unknown}" End If If c.Value <> val Then Debug.Print "Changed:", addr, IIf(val = "", "Empty", val), _ " to ", IIf(c.Value = "", "Empty", c.Value) End If Next c End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim c As Range If PreviousValues Is Nothing Then Set PreviousValues = CreateObject("scripting.dictionary") Else PreviousValues.RemoveAll End If If Target.Cells.Count <= MAX_TRACKED_CELLS Then For Each c In Target.Cells PreviousValues.Add c.Address(), c.Value Next c End If End Sub