如果选中复选框，则更改下一个工作表上单元格的单元格颜色

Question

我有一个 Excel 文档，其中包含代表每个月信息的表格。这些工作表包含成员列表。每张纸上有多个复选框（每张纸大约 250 个）。我想做以下事情。

让我们以几个月 September 和 October 为例。如果我选中September-sheet 上的复选框，则复选框所在的同一单元格的颜色（例如D23）在下一张表上（在本例中为"October"）应该变为蓝色。如果未选中相同的复选框（即使将来），则单元格应变为红色。

1. 选中'September'!D:23 上的复选框
2. 下一张纸上D23 单元格上的颜色October 变为蓝色
3. 取消选中'September'!D:23 上的复选框
4. 下一张纸上D23 单元格上的颜色October 变为红色

我解决问题的方法：我写了一个Sub，当创建一个复选框时，它将复选框链接到它所在的单元格（例如D23），这样我就可以知道哪个单元格在下一张纸上选中/取消选中时需要更改：

.LinkedCell = Selection.Address(False, False)

这是我迄今为止尝试过的，但没有成功：

Sub SetMacro()
  Dim cb
  For Each cb In ActiveSheet.CheckBoxes
    If cb.OnAction = "" Then cb.OnAction = "CheckedUnchecked"
  Next cb
End Sub

这里是检查/取消检查的代码：

Sub CheckedUnchecked()
With ActiveSheet.Range(ActiveSheet.CheckBoxes(Application.Caller).LinkedCell)
    If .Value Then
        Worksheet(ActiveSheet.Index + 1).Range(ActiveSheet.CheckBoxes(Application.Caller).LinkedCell).Interior.ColorIndex = 5
    Else
    Worksheet(ActiveSheet.Index + 1).Range(ActiveSheet.CheckBoxes(Application.Caller).LinkedCell).Interior.ColorIndex = 3
    End If
End With
End Sub

对这个问题有什么想法吗？

Answer 1

工作表有一个.Next 方法，它引用工作表集合中的下一个工作表。如果工作表是集合中的最后一个工作表，它将不返回任何内容。

粘贴到标准模块中

Sub CheckedUnchecked()
    Dim cb As CheckBox
    With ActiveSheet
        Set cb = .CheckBoxes(Application.Caller)
        If Not cb Is Nothing Then
            If .Next Is Nothing Then
                Worksheets("January").Range(cb.TopLeftCell.Address).Interior.ColorIndex = IIf(cb.Value = 1, 5, 3)
            Else
                .Next.Range(cb.TopLeftCell.Address).Interior.ColorIndex = IIf(cb.Value = 1, 5, 3)
            End If
        End If
    End With
End Sub

Answer 2

已编辑 NextMonthSht() 以正确处理 9 后的月份 index

下面是一个稍微不同的解决方案：

• 允许任何索引顺序的月份表

• 允许任何工作表名称

代码：

Sub CheckedUnchecked()
    With ActiveSheet.CheckBoxes(Application.Caller)
        NextMonthSht.Range(.TopLeftCell.Address).Interior.ColorIndex = IIf(.Value = 1, 5, 3)
    End With
End Sub

Function NextMonthSht() As Worksheet
    Const MONTHS As String = "January,February,March,April,Maj,June,July,August,September,October,November,December,January"

    Set NextMonthSht = Worksheets(Split(MONTHS, ",")(Len(Left(MONTHS, InStr(MONTHS, ActiveSheet.name))) - Len(Replace(Left(MONTHS, InStr(MONTHS, ActiveSheet.name)), ",", "")) + 1))
End Function