Excel 跟踪布尔值更改

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

全部在此工作簿对象中。

这很好用！除非工作表上正在更改的值为 TRUE/FALSE 值。例如，我在工作表上有一些复选框表单控件，可将单元格的值更改为 TRUE/FALSE。我想跟踪这些值何时更改，但上面的代码不会捕获这些更改。我尝试使用几种不同的 If 语句，例如 If .值 = 真然后是"真"等，但似乎代码甚至没有将 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事件处理程序

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