Question

我是新来的（和VBA的初学者）。我试图修改此代码，仅为范围（＆＃34; B21：B40＆＃34;）中不是空的单元格设置复选框。

代码尚未就绪。我不确定如何为每个循环工作pararell构建两个，一个将检查Range中的内容（＆＃34; B21：B25＆＃34;）和下一个Range（＆＃34; A21：A25＆＃34;）将设置复选框

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 请让我知道我做错了什么。

Answer 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

当单元格后面没有空时

1 个答案: