Question

我环顾四周但无法弄清楚如何在单个单元格中添加两个复选框。我是否需要使用OLEObjects.Add？我需要在E列中添加两列复选框。提前感谢。

这是我的尝试：

LRow = ActiveSheet.Range("G" & Rows.count).End(xlUp).Row

For cell = 2 To LRow

    If Cells(cell, "G").Value <> "" Then

        CLeft = Cells(cell, "E").Left

        CTop = Cells(cell, "E").Top

        CHeight = Cells(cell, "E").Height / 2

        CWidth = Cells(cell, "E").Width


        ActiveSheet.CheckBoxes.Add(CLeft, CTop, CWidth, CHeight).Select

        With Selection
            .Caption = ""
            .name = "cbSet1_" & cell
            .Value = xlOff
            .LinkedCell = "E" & cell
            .Display3DShading = False

        End With
    End If
Next cell

For cellF = 2 To LRow

    If Cells(cellF, "G").Value <> "" Then

        CLeftF = Cells(cellF, "E").Left

        CTopF = Cells(cellF, "E").Top

        CHeightF = Cells(cellF, "E").Height

        CWidthF = Cells(cellF, "E").Width


        ActiveSheet.CheckBoxes.Add(CLeftF, CTopF, CWidthF, CHeightF).Select

        With Selection
            .Caption = ""
            .name = "cbSet2_" & cell
            .Value = xlOff
            .Display3DShading = False
        End With
    End If
Next cellF

Answer 1

I made a small changes to your code. We don't need two loop.

If it is not OK, let me known. Try With this.

LRow = ActiveSheet.Range("G" & Rows.count).End(xlUp).row

For cell = 2 To LRow

    If Cells(cell, "G").Value <> "" Then

        'Getting left, top, height and width
        CLeft = Cells(cell, "E").Left

        CTop = Cells(cell, "E").Top

        CHeight = Cells(cell, "E").Height / 2

        CWidth = Cells(cell, "E").Width / 2

        'Add first check box
        ActiveSheet.CheckBoxes.Add(CLeft, CTop, CWidth, CHeight).Select

        With Selection
            .Caption = ""
            .Name = "cbSet1_" & cell
            .Value = xlOff
            .LinkedCell = "E" & cell
            .Display3DShading = False

        End With

        'Add second check box
        ActiveSheet.CheckBoxes.Add(CLeft + CWidth, CTop, CWidth, CHeight).Select

        With Selection
            .Caption = ""
            .Name = "cbSet2_" & cell
            .Value = xlOff
            .Display3DShading = False
        End With

    End If

Next cell

如何将两个命名复选框添加到一个单元格

1 个答案: