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

Posted 2023-03-05

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

【英文标题】：Change cell color of cell on next worksheet if checkbox is checked

【发布时间】：2017-01-30 09:03:44

【问题描述】：

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

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

选中'September'!D:23 上的复选框 下一张纸上D23 单元格上的颜色October 变为蓝色 取消选中'September'!D:23 上的复选框 下一张纸上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

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

【参考方案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

【讨论】：

代码运行良好，但有一个例外，即“十一月”月份。 “十二月”是本工作簿中的最后一张纸，但由于某种原因，如果我选中“十一月”中的复选框，单元格颜色不会改变......对此有什么想法吗？

还有一个问题：你是如何让选中复选框后出现的“TRUE”或“FALSE”看不见的？

这段代码在前两个月工作得很好，但遗憾的是在其他几个月里就不行了......你对此有什么想法吗？

这里是文件的链接。请注意，我匿名化了姓名和头衔，但这不应妨碍：drive.google.com/file/d/0B6v7lPApXN7mZjJjRWVvM3ZNdGc/…

我找到了解决方案。我多次复制工作表时犯了一个错误。这样，复选框在每张纸上都有相同的名称。在我手动插入每张纸上的每个单元格（避免多个具有相同名称的复选框）之后，它就起作用了。

【参考方案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

【讨论】：

@ThomasInzina，感谢您注意到两位数月份的问题。我处理它（仍然）避免使用 Date 函数来保持处理 “任何工作表名称”

的“承诺”功能

@ThomasInzina，谢谢。我可以使用数组，但我不会减轻用户输入的负担。虽然我没有得到“Worksheets (Month(ActiveSheet.name & " 1")) ”的东西

@ThomasInzina，仍然无法得到“Month(ActiveSheet.name & "1")" 应该做什么。我不在我的电脑旁，但在我看来，它应该评估为无法弄清楚的“月份（“1 月 1 日”）”。此外，如果“月份”是一个“日期”函数，那么它仍然会违背我允许任何工作表名称（不仅仅是月份名称）的目的。

@user3598756 与上面的代码相同...它适用于第一个和第二个工作表，但对于其余的则不起作用。我是否需要将代码粘贴到 VBA 模块“本工作簿”中？还是我应该将它粘贴到一个随机模块中，它会自动工作？