Excel VBA脚本用于插入多个链接到单元格的复选框，使用yes和no而不是true和false

Question

我正在研究一个庞大的excel文件，我需要插入带有复选框的多个单元格，我需要将这些框附加到它们出现的单元格上，我需要输出说“清除”或“”目前他们说的“对或错”。到目前为止，我有以下代码来批量生成单元格但现在我需要调整此代码以将输出更改为“已清除”或“”经文“True”或“False”。

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

您可以采用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 2

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语句中使用组合框的索引或名称来决定最终输出的内容。

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 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

您可能希望调整列宽和文本对齐，因为框现在与文本重叠。