Excel VBA腳本插入多個複選框鏈接到單元格與是和否而不是真假

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

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 2

隱藏與真/假柱中，並用一個IF式插入另一列旁邊引用真/假（= 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 

您可能想調整列寬和文本對齊，因爲現在框與文本重疊。

Answer 3

，你可以採取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