当后面的单元格不为空时设置复选框的 Excel VBA 代码答案

【问题标题】：Excel VBA code that sets checkbox when cell behind isn't empty当后面的单元格不为空时设置复选框的 Excel VBA 代码
【发布时间】：2018-03-13 16:43:06
【问题描述】：

我是新来的（也是 VBA 的初学者）。我尝试修改此代码以仅为 Range("B21:B40") 中非空的单元格设置复选框。

代码尚未准备好。我不确定如何为每个并行工作的循环构建两个，一个将检查 Range("B21:B25") 中的内容，而 Range("A21:A25") 中的下一个将设置复选框

Sub ActiveCheckBox()

Dim setRange As Range, cel As Range
Dim checkRange As Range, cel1 As Range
Dim wks As Worksheet
Dim cb As Checkbox

Set wks = Sheets("InterFace")
Set setRange = wks.Range("A21:A25")
Set checkRange = wks.Range("B21:B25")

For Each cel1 In checkRange
    If cel1 <> "" Then
        For Each setRange In checkRange
            Set cb = cel.Worksheet.CheckBoxes.Add(cel.Left + cel.Width / 2 - 8.25, _
                    cel.Top + cel.Height / 2 - 8.25, 0, 0)  ' 8.25 is cb.Height / 2
                    With cb
                    .Text = vbNullString                      ' to clear Caption
                    .LinkedCell = cel.Address(0, 0)             ' Example A1 instead of $A$1
                    .Name = "cb" & cb.LinkedCell              ' optional
                    End With
        Next
    End If
Next

setRange.NumberFormat = ";;;" ' optional to hide the cell values

End Sub

为了构建，我使用了这个主题的代码Script to Insert a Checkbox into every cell and assign it to that cell in Excel 请让我知道我做错了什么。

【问题讨论】：

是什么样的复选框？通过 Formcontrol，还是通过 ActiveX？
你有For each *cel1*，然后你有没有1的*cel*.left。你不需要2个for循环，因为你只需要遍历一次单元格。如果您通过 checkRange 列 B，您可以使用 cel.offest(0,-1) 检查列 A 中的单元格是否为空，例如if cel.offset(0,-1) <> "" Then 并使用 set cb = cel.worksheet...... 在单元格中放置一个复选框

标签： vba excel checkbox excel-2013

【解决方案1】：

@Gordon 感谢您的帮助！！

下面我发布了工作代码。另外我补充说：宏在工作表更改时运行，并在添加新复选框之前删除复选框。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim setRange As Range, cel As Range
Dim checkRange As Range, cel1 As Range
Dim wks As Worksheet
Dim cb As Checkbox

Set wks = Sheets("InterFace")
Set setRange = wks.Range("A18:A30")
Set checkRange = wks.Range("A18:A30")

For Each cb In ActiveSheet.CheckBoxes
    cb.Delete
Next

For Each cel In setRange
    If cel.Offset(0, 1) <> "" Then
        Set cb = cel.Worksheet.CheckBoxes.Add(cel.Left + cel.Width / 2 - 8.25, _
                    cel.Top + cel.Height / 2 - 8.25, 0, 0)  ' 8.25 is cb.Height / 2
                    With cb
                    .Text = vbNullString                      ' to clear Caption
                    .LinkedCell = cel.Address(0, 0)             ' Example A1 instead of $A$1
                    .Name = "cb" & cb.LinkedCell              ' optional
                    End With


    End If
Next
End Sub

【讨论】：