Excel VBA 将复选框添加到范围 - 当电子表格位于第二个显示器上时，顶部位置会发生漂移

Question

我有一个简单的宏，可以向范围内的每个单元格添加一个复选框，将其链接到该单元格，并且（应该如此！）将其放置在单元格的左上角附近。

    Set TargetRange = Worksheets("Sheet 1").Range("Table_1").Columns(5)
    For Each Cell In TargetRange.Cells
        With ActiveSheet.CheckBoxes.Add(Cell.Left, Cell.Top - 1, 24, Cell.Height - 14)
            .LinkedCell = Cell.Address
            .Caption = ""
            .Name = "Checkbox " & Cell.Address
        End With
    Next Cell

第一个复选框看起来不错，但即使插入了 5 个复选框，您也可以看到漂移：

输入 50 时，复选框位于下一行：

为什么 Cell.Top 在第一个复选框之后不正确？

我可以手动将复选框放在彼此的顶部，这样它们就不会被前一个复选框按下。

我尝试将顶部位置设置为

Cell.Top - Count

，但这是一个障碍，并且压缩了它们太多。我不必尝试比例因子，Cell.Top 应该完全满足我的需要。

更新：我正在运行 3 个显示器。我的 VBA 窗口就在我面前（因为这是我大部分时间都在处理的事情），4K 分辨率，150% 缩放。我的电子表格位于侧面显示器上，分辨率为 1080p。如果我交换窗口位置（即主 4K 显示器上的电子表格），它会按预期工作：

Sooo.. 很烦恼，但还没有结束。 :/

更新以显示 150% -> 100% 缩放的结果：

Answer 1

根据您的要求，我发布了 2 个替代方案。

选项 1

此选项使用

Worksheet_BeforeDoubleClick

事件。您必须双击单元格才能选中/取消选中这些框。

假设您希望复选框显示在

Range("D2:D10")

中。将此范围的字体更改为

Wingdings 2

将此代码粘贴到工作表代码模块中。

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("D2:D10")) Is Nothing Then
        If Target.Value = "£" Then Target.Value = "R" Else Target.Value = "£"
        Cancel = True
    End If
End Sub

在行动

选项 2

此选项使用

Worksheet_SelectionChange

事件。您必须单击单元格才能选中/取消选中这些框。

假设您希望复选框显示在

Range("D2:D10")

中。将此范围的字体更改为

Wingdings 2

在 E 列单元格中，添加公式

=D2="R"

将此代码粘贴到工作表代码模块中。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub

    If Not Intersect(Target, Range("D2:D10")) Is Nothing Then
        If Target.Value = "£" Then Target.Value = "R" Else Target.Value = "£"
        Target.Offset(, 1).Select
    End If
End Sub

在行动

Excel 文件示例

注意：这只是一个例子。我没有做任何错误处理或使其万无一失来处理其他场景。