如何将两个命名复选框添加到一个单元格(How to add two named checkboxes to one cell)

如何将两个命名复选框添加到一个单元格(How to add two named checkboxes to one cell)

我环顾四周但无法弄清楚如何在一个单元格中添加两个复选框。 我是否需要使用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

I've looked around but can't figure out how to add two checkboxes to a single cell. Do I need to use OLEObjects.Add or not? I need to add two columns of checkboxes in column E. Thanks in advance.

Here is my attempt:

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

最满意答案

我对您的代码做了一些小改动。 我们不需要两个循环。

如果不行，请告诉我。 试试这个。

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

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