Question

我正在使用VBA代码来跟踪工作簿中的更改（以及绕过Excel糟糕的共享工作簿/跟踪更改功能），使用以下代码：

Option Explicit
Dim sOldAddress As String
Dim vOldValue As Variant
Dim sOldFormula As String

然后

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)

    Dim wSheet As Worksheet
    Dim wActSheet As Worksheet
    Dim iCol As Integer
    Set wActSheet = ActiveSheet

     'Precursor Exits
     'Other conditions that you do not want to tracke could be added here
    'If vOldValue = "" Then Exit Sub 'If you comment out this line *every* entry will be recorded
     'Continue

    On Error Resume Next ' This Error-Resume-Next is only to allow the creation of the tracker sheet.
    Set wSheet = Sheets("Workbook History")
     '**** Add the tracker Sheet if it does not exist ****

    If wSheet Is Nothing Then
        Set wActSheet = ActiveSheet
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Workbook History"
    End If
    On Error GoTo 0
     '**** End of specific error resume next

    On Error GoTo ErrorHandler
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    With Sheets("Workbook History")
         '******** This bit of code moves the tracker over a column when the first columns are full**'
        If .Cells(4, 1) = "" Then '
            iCol = 1 '
        Else '
            iCol = .Cells(4, 256).End(xlToLeft).Column - 7 '
            If Not .Cells(65536, iCol) = "" Then '
                iCol = .Cells(4, 256).End(xlToLeft).Column + 1 '
            End If '
        End If '
         '********* END *****************************************************************************'
        .Unprotect Password:="Secret"

         '******** Sets the Column Headers **********************************************************
        If LenB(.Cells(4, iCol).Value) = 0 Then
            .Range(.Cells(4, iCol), .Cells(4, iCol + 7)) = Array("Cell Changed", "Old Value", _
            "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
            .Cells.Columns.AutoFit
        End If

        With .Cells(.Rows.Count, iCol).End(xlUp).Offset(1)

            .Value = sOldAddress

                .Offset(0, 1).Value = vOldValue
                .Offset(0, 3).Value = sOldFormula

            If Target.Count = 1 Then
                    .Offset(0, 2).Value = Target.Value

            If Target.HasFormula Then .Offset(0, 4).Value = "'" & Target.Formula
            End If

            .Offset(0, 5) = Time
            .Offset(0, 6) = Date
            .Offset(0, 7) = Application.UserName
            .Offset(0, 7).Borders(xlEdgeRight).LineStyle = xlContinuous
        End With

         '.Protect Password:="Secret"  'Uncomment to protect the "tracker tab"

    End With
ErrorExit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

    wActSheet.Activate
    Exit Sub

ErrorHandler:
     'any error handling you want
     'Debug.Print "We have an error"
    Resume ErrorExit

End Sub

然后

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)

    With Target
        sOldAddress = "'" & .Parent.Name & "'!" & .Address(external:=False)

        If .Count > 1 Then
            vOldValue = "Multiple Cell Select"
            sOldFormula = vbNullString
        Else

            vOldValue = .Value

        If .HasFormula Then
            sOldFormula = "'" & Target.Formula
        Else
            sOldFormula = vbNullString
        End If

        End If
    End With
End Sub

所有在ThisWorkbook对象中。

这很棒！除非工作表上更改的值为TRUE / FALSE值。例如，我在工作表上有一些复选框表单控件，它将单元格的值更改为TRUE / FALSE。我想跟踪这些值何时发生变化，但上面的代码不会捕获这些变化。我尝试过使用几种不同的If语句，如If .Value = True Then＆＃34; TRUE＆＃34;等等，但似乎代码甚至没有将TRUE / FALSE更改识别为更改！

有关如何使用VBA捕获范围内TRUE / FALSE值的更改的任何想法？

谢谢！

Answer 1

继续GSerg的评论......

将此代码放在ThisWorkbook模块中，并将其分配给所有复选框：

Public Sub CBClick()
    Dim addr As String

    addr = ActiveSheet.CheckBoxes(Application.Caller).LinkedCell
    With ActiveSheet.Range(addr)
        .Value = .Value
    End With

End Sub

然后应该触发现有的Change事件处理程序

编辑：我刚注意到你需要做一些修改来模仿选择更改处理程序中的一些操作，但这至少应该给你一个开始...

Excel跟踪布尔更改

1 个答案: