Excel VBA脚本插入多个checkbox链接到单元格与是和否，而不是真和假

我正在处理一个庞大的Excel文件，我需要插入多个单元格与checkbox，我需要附加到他们出现在单元格上的那些盒子，我需要输出说“清除”或“”经文，目前他们说“真”或“假”。 到目前为止，我有以下代码来批量生产单元格，但现在我需要调整此代码，以改变输出说“清除”或“”经文“真”或“假”。

Sub AddCheckBoxes() Dim cb As CheckBox Dim myRange As Range, cel As Range Dim wks As Worksheet Set wks = Sheets("Sheet1") Set myRange = wks.Range("A1:A1000") For Each cel In myRange Set cb = wks.CheckBoxes.Add(cel.Left, cel.Top, 30, 6) With cb .Caption = "" .LinkedCell = cel.Address End With Next End Sub 

任何人都可以帮我解决这个问题吗？

Answer 1

 Sub AddCheckBoxes() Dim cb As CheckBox Dim myRange As Range, cel As Range Dim wks As Worksheet Set wks = Sheets("Sheet1") Set myRange = wks.Range("A1:A1000") For Each cel In myRange Set cb = wks.CheckBoxes.Add(cel.Left, cel.Top, 30, 6) With cb .Caption = "" .OnAction = "ProcessCheckBox" End With Next End Sub Sub ProcessCheckBox() Dim cb As CheckBox With Sheets("Sheet1") Set cb = .CheckBoxes(Application.Caller) If Not cb Is Nothing Then cb.TopLeftCell = IIf(cb.Value = 1, "Cleared", "") End With End Sub 

重要： ProcessCheckBox()模块必须位于标准模块中。 如果是工作表模块，您将收到此消息：

如果您要使代码更加灵活，您可以在Select Case语句中使用combobox的索引或名称来决定最终的输出结果。

---

 Sub ProcessCheckBox() Dim cb As CheckBox With Sheets("Sheet1") Set cb = .CheckBoxes(Application.Caller) If Not cb Is Nothing Then Select Case cb.Index Case 1, 2, 4 cb.TopLeftCell = IIf(cb.Value = 1, "Cleared", "") Case 3, 5, 7 cb.TopLeftCell = IIf(cb.Value = 1, 1, 0) Case Else cb.TopLeftCell = IIf(cb.Value = 1, True, False) End Select End If End With End Sub 

Answer 2

你可以采用如下的Shapes方法：

 Option Explicit Sub AddCheckBoxes() With Sheets("Sheet1") AddRangeCheckBoxes .Range("A1:A2"), "|YES\NO" AddRangeCheckBoxes .Range("B1:B2"), "|Cleared\" End With End Sub Sub AddRangeCheckBoxes(rng As Range, outputs As String) Dim cel As Range With rng.Parent For Each cel In rng With .Shapes.AddFormControl(xlCheckBox, cel.Left, cel.Top, 30, 6) .TextFrame.Characters.Text = "" .AlternativeText = cel.Address(False, False) & outputs .OnAction = "UpdateCheckBox" End With Next cel End With End Sub Sub UpdateCheckBox() Dim cellAddr As String Dim val As String With Worksheets("Sheet1") With .Shapes(Application.Caller) cellAddr = Split(.AlternativeText, "|")(0) val = Split(Split(.AlternativeText, "|")(1), "\")(IIf(.OLEFormat.Object.Value = 1, 0, 1)) End With .Range(cellAddr).Value = val End With End Sub 

Answer 3

使用true / false隐藏列，并在其中插入另一个列，其中IF公式引用true / false（= IF（B1，“清除”，“未清除”））

 Sub AddCheckBoxes() Dim cb As CheckBox Dim myRange As Range, cel As Range Dim wks As Worksheet Set wks = Sheets("Sheet1") Set myRange = wks.Range("A1:A1000") For Each cel In myRange Set cb = wks.CheckBoxes.Add(cel.Left, cel.Top, 30, 6) With cb .Caption = "" .LinkedCell = cel.Address End With cel.Offset(0, 1).FormulaR1C1 = "=IF(RC[-1],""Cleared"",""Not cleared"")" Next wks.Range("A:A").EntireColumn.Hidden = True End Sub 

您可能需要调整列宽和文本alignment方式，因为方框现在与文本重叠。