Excel 使用可移除复选框的多个可选宏_Excel_Vba_Checkbox

Excel 使用可移除复选框的多个可选宏

excel vba checkbox

Excel 使用可移除复选框的多个可选宏,excel,vba,checkbox,Excel,Vba,Checkbox,感谢这些指示如何使用VBA将宏动态指定给复选框我想出了一个主意：将复选框放在工作表上我想要的位置，例如，在表格右侧的列中，包含要处理的数据将它们的（取消）检查与逻辑变量相连接，逻辑变量用于是否启动某些过程等待用户做出选择，并选中某些复选框（例如列表中的最后一个复选框）以启动所选程序删除所有（！）复选框，并在之前不久启动所选的过程。通过这种方式，包含可选过程的宏是可移植的，因为它们不依赖于打开的文件，而只在这些文件上工作。通过宏中编码的这些自由控制按钮，文件本身保持不变（即带有复

感谢这些指示如何使用VBA将宏动态指定给复选框

我想出了一个主意：

将复选框放在工作表上我想要的位置，例如，在表格右侧的列中，包含要处理的数据

将它们的（取消）检查与逻辑变量相连接，逻辑变量用于是否启动某些过程

等待用户做出选择，并选中某些复选框（例如列表中的最后一个复选框）以启动所选程序

删除所有（！）复选框，并在之前不久启动所选的过程。通过这种方式，包含可选过程的宏是可移植的，因为它们不依赖于打开的文件，而只在这些文件上工作。通过宏中编码的这些自由控制按钮，文件本身保持不变（即带有复选框的工作表返回到其以前的状态）

以下宏创建自己的复选框（在H列），等待用户选择选项，记忆选项，删除所有复选框，运行其他过程。。。并最终在工作簿中不留任何痕迹

Dim FirstOptionLogical, SecondOptionLogical, ThirdOptionLogical As Boolean

' Making new checkboxes

Sub CheckBOxAdding()
Dim i As Long, id As Long
Dim cel As Range
Dim cbx As CheckBox

On Error GoTo CheckBoxAddingERROR

'FirstOptionLogical = False
'SecondOptionLogical = False
'ThirdOptionLogical = False
    
    ' Deleting all checkboxes, if any found
    ' Preventing error stops if there is no checkbox
    On Error Resume Next
    ' Repeating with all checkboxes on active sheet
    For Each chkbx In ActiveSheet.CheckBoxes
 
    ' Removing a checkbox
    chkbx.Delete
 
    ' Next checkbox
    Next

    Range("G3").Select
    ActiveSheet.Range(Columns("G:G"), Selection.End(xlToRight)).Select
    Selection.Delete Shift:=xlToLeft
    On Error GoTo 0
    
    Set cel = ActiveSheet.Cells(3, 8)
    With cel
        Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
    End With
    cbx.Name = "Option_1"
    cbx.Caption = "First Attribute changes, name it"
    cbx.Display3DShading = True
    
 ' with a linked can trap sheet change event or link to other formulas
        cbx.LinkedCell = cel.Offset(0, -1).Address
        cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
''''''''''   
    
    Set cel = ActiveSheet.Cells(5, 8)
    With cel
        Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
    End With
    cbx.Name = "Option_2"
    cbx.Caption = "Second Attribute changes, name it"
    cbx.Display3DShading = True
    
 ' with a linked can trap sheet change event or link to other formulas
        cbx.LinkedCell = cel.Offset(0, -1).Address
        cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
    
    Set cel = ActiveSheet.Cells(7, 8)
    With cel
        Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
    End With
    cbx.Name = "Option_3"
    cbx.Caption = "Third Attribute changes, name it"
    cbx.Display3DShading = True
    
 ' with a linked can trap sheet change event or link to other formulas
        cbx.LinkedCell = cel.Offset(0, -1).Address
        cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
    
    Set cel = ActiveSheet.Cells(9, 8)
    With cel
        Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
        ' .Font.Size = 36
        
' height will autosize larger to the font
    End With
    cbx.Name = "Option_4"
    cbx.Caption = "START THE MACRO"
    cbx.Display3DShading = True
    
    
 ' with a linked can trap sheet change event or link to other formulas
        cbx.LinkedCell = cel.Offset(0, -1).Address
        cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
    
Exit Sub

CheckBoxAddingERROR:

   MsgBox "Something went wrong... ;-) in the sub CheckBOxAdding", vbCritical + vbOKOnly
   End

End Sub

Sub CheckBoxHandling()
Dim sCaller, UsersChoice As String
Dim id As Long
Dim cbx As CheckBox
Dim shp As Shape

UsersChoice = ""

On Error GoTo CheckBoxHandlingERROR

    sCaller = Application.Caller
    Set shp = ActiveSheet.Shapes(sCaller)
    Set cbx = ActiveSheet.CheckBoxes(sCaller)

    id = Val(Mid$(sCaller, Len("Option_") + 1, 5))

    ' maybe something based on Select Case?
    Select Case id
        Case 1:
            'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of First Attribute changes, name it'"
            FirstOptionLogical = Not FirstOptionLogical
            'FirstOptionLogical = IIf(cbx.Value = xlOn, True, False)
            'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
        Case 2:
            'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of Second Attribute changes, name it'"
            SecondOptionLogical = Not SecondOptionLogical
            'SecondOptionLogical = IIf(cbx.Value = xlOn, True, False)
            'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
        Case 3:
            'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of Third Attribute changes, name it'"
            ThirdOptionLogical = Not ThirdOptionLogical
            'ThirdOptionLogical = IIf(cbx.Value = xlOn, True, False)
            'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
        Case 4:
            If FirstOptionLogical Then
                UsersChoice = UsersChoice & "- Larger description of First Attribute changes, name it " & vbCrLf
            End If
            If SecondOptionLogical Then
                UsersChoice = UsersChoice & "- Larger description of Second Attribute changes, name it " & vbCrLf
            End If
            If ThirdOptionLogical Then
                UsersChoice = UsersChoice & "- Larger description of Third Attribute changes, name it " & vbCrLf
            End If
            
            Ans0 = MsgBox("The following options were chosen:" & vbCrLf & UsersChoice & vbCrLf & vbCrLf & _
                    "You chose a checkbox with an option" & vbCrLf & "'START THE MACRO'" & vbCrLf & vbCrLf & " S H O U L D   W E   S T A R T   T H E   M A C R O ? ", vbYesNo + vbDefaultButton2 + vbQuestion)

            If Ans0 = vbYes Then
               
                'MACRO WITH PARAMETERS WE CHOSE BY CLICKING GETS STARTED...
        ' Delete all remaining checkboxes, if any (removing traces of the macro)

                ' In case of error, resume
        On Error Resume Next
        For Each chkbx In ActiveSheet.CheckBoxes
            chkbx.Delete
        Next

                ' Deleting all columns from G to the right
                Range("G3").Select
                ActiveWorkbook.Sheets(1).Range(Columns("G:G"), Selection.End(xlToRight)).Select
                Selection.Delete Shift:=xlToLeft
                
        ' Resetting on Error event to default
                On Error GoTo 0

                ' If chosen, start sub 'Larger description of First Attribute changes, name it'
                If FirstOptionLogical Then Call RunFirstOptionSub ' Name of the Sub

                ' If chosen, start sub 'Larger description of Second Attribute changes, name it'
                If SecondOptionLogical Then Call RunSecondOptionSub ' Name of the Sub

                ' If chosen, start sub 'Larger description of Third Second Attribute changes, name it'
                If ThirdOptionLogical Then Call RunThirdOptionSub ' Name of the Sub

            Else
                
                If Ans0 = vbNo Then
            
                End If
            
            End If
            
            Exit Sub
            
    End Select

    cbx.TopLeftCell.Offset(, 2).Interior.Color = IIf(cbx.Value = xlOn, vbGreen, vbRed)
    'MsgBox cbx.Caption & vbCr & IIf(cbx.Value = xlOn, " is ", " is not ") & "chosen"
    
Exit Sub
    
CheckBoxHandlingERROR:
   MsgBox "Something went wrong... ;-) in the Sub CheckBoxHandling", vbCritical + vbOKOnly

End Sub

Sub RunFirstOptionSub()
' CODE
End Sub

Sub RunSecondOptionSub()
' CODE
End Sub

Sub RunThirdOptionSub()
' CODE
End Sub

Sub MacroWithOptionsEndsWithoutATrace()

FirstOptionLogical = False
SecondOptionLogical = False
ThirdOptionLogical = False

' OPTIONAL: Delete all remaining checkboxes, if any (most important when testing macro)

On Error Resume Next
For Each chkbx In ActiveSheet.CheckBoxes
    chkbx.Delete
Next

' Resetting on Error event to default
On Error GoTo 0

CheckBOxAdding

End Sub

分享和使用你想要的，就像我使用别人的知识和经验

我很抱歉，但是我还没有找到任何其他的解决方案来向您展示这个，我也没有发现任何其他人展示类似的东西

2019年12月17日更新：您还可以更简单地使用这些复选框：编写一个

在以下位置创建一个空白工作表：=工作表（Sheets.Count），以便它现在成为新的“最后一张工作表”

把这些复选框放在那里

选中/取消选中它们，然后通过单击其中最低的一个来启动宏

删除最后一个工作表，不留下宏的痕迹这样你就不必再考虑在哪里放置临时复选框了

更新日期：2020年10月7日：

我最后认为，最好是将此问题作为一个已回答的问题，因为它是。

以下宏创建自己的复选框（在H列中），等待用户选择选项，记忆选项，删除所有复选框，运行其他过程。。。并最终在工作簿中不留任何痕迹

Dim FirstOptionLogical, SecondOptionLogical, ThirdOptionLogical As Boolean

' Making new checkboxes

Sub CheckBOxAdding()
Dim i As Long, id As Long
Dim cel As Range
Dim cbx As CheckBox

On Error GoTo CheckBoxAddingERROR

'FirstOptionLogical = False
'SecondOptionLogical = False
'ThirdOptionLogical = False
    
    ' Deleting all checkboxes, if any found
    ' Preventing error stops if there is no checkbox
    On Error Resume Next
    ' Repeating with all checkboxes on active sheet
    For Each chkbx In ActiveSheet.CheckBoxes
 
    ' Removing a checkbox
    chkbx.Delete
 
    ' Next checkbox
    Next

    Range("G3").Select
    ActiveSheet.Range(Columns("G:G"), Selection.End(xlToRight)).Select
    Selection.Delete Shift:=xlToLeft
    On Error GoTo 0
    
    Set cel = ActiveSheet.Cells(3, 8)
    With cel
        Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
    End With
    cbx.Name = "Option_1"
    cbx.Caption = "First Attribute changes, name it"
    cbx.Display3DShading = True
    
 ' with a linked can trap sheet change event or link to other formulas
        cbx.LinkedCell = cel.Offset(0, -1).Address
        cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
''''''''''   
    
    Set cel = ActiveSheet.Cells(5, 8)
    With cel
        Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
    End With
    cbx.Name = "Option_2"
    cbx.Caption = "Second Attribute changes, name it"
    cbx.Display3DShading = True
    
 ' with a linked can trap sheet change event or link to other formulas
        cbx.LinkedCell = cel.Offset(0, -1).Address
        cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
    
    Set cel = ActiveSheet.Cells(7, 8)
    With cel
        Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
    End With
    cbx.Name = "Option_3"
    cbx.Caption = "Third Attribute changes, name it"
    cbx.Display3DShading = True
    
 ' with a linked can trap sheet change event or link to other formulas
        cbx.LinkedCell = cel.Offset(0, -1).Address
        cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
    
    Set cel = ActiveSheet.Cells(9, 8)
    With cel
        Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
        ' .Font.Size = 36
        
' height will autosize larger to the font
    End With
    cbx.Name = "Option_4"
    cbx.Caption = "START THE MACRO"
    cbx.Display3DShading = True
    
    
 ' with a linked can trap sheet change event or link to other formulas
        cbx.LinkedCell = cel.Offset(0, -1).Address
        cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
    
Exit Sub

CheckBoxAddingERROR:

   MsgBox "Something went wrong... ;-) in the sub CheckBOxAdding", vbCritical + vbOKOnly
   End

End Sub

Sub CheckBoxHandling()
Dim sCaller, UsersChoice As String
Dim id As Long
Dim cbx As CheckBox
Dim shp As Shape

UsersChoice = ""

On Error GoTo CheckBoxHandlingERROR

    sCaller = Application.Caller
    Set shp = ActiveSheet.Shapes(sCaller)
    Set cbx = ActiveSheet.CheckBoxes(sCaller)

    id = Val(Mid$(sCaller, Len("Option_") + 1, 5))

    ' maybe something based on Select Case?
    Select Case id
        Case 1:
            'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of First Attribute changes, name it'"
            FirstOptionLogical = Not FirstOptionLogical
            'FirstOptionLogical = IIf(cbx.Value = xlOn, True, False)
            'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
        Case 2:
            'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of Second Attribute changes, name it'"
            SecondOptionLogical = Not SecondOptionLogical
            'SecondOptionLogical = IIf(cbx.Value = xlOn, True, False)
            'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
        Case 3:
            'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of Third Attribute changes, name it'"
            ThirdOptionLogical = Not ThirdOptionLogical
            'ThirdOptionLogical = IIf(cbx.Value = xlOn, True, False)
            'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
        Case 4:
            If FirstOptionLogical Then
                UsersChoice = UsersChoice & "- Larger description of First Attribute changes, name it " & vbCrLf
            End If
            If SecondOptionLogical Then
                UsersChoice = UsersChoice & "- Larger description of Second Attribute changes, name it " & vbCrLf
            End If
            If ThirdOptionLogical Then
                UsersChoice = UsersChoice & "- Larger description of Third Attribute changes, name it " & vbCrLf
            End If
            
            Ans0 = MsgBox("The following options were chosen:" & vbCrLf & UsersChoice & vbCrLf & vbCrLf & _
                    "You chose a checkbox with an option" & vbCrLf & "'START THE MACRO'" & vbCrLf & vbCrLf & " S H O U L D   W E   S T A R T   T H E   M A C R O ? ", vbYesNo + vbDefaultButton2 + vbQuestion)

            If Ans0 = vbYes Then
               
                'MACRO WITH PARAMETERS WE CHOSE BY CLICKING GETS STARTED...
        ' Delete all remaining checkboxes, if any (removing traces of the macro)

                ' In case of error, resume
        On Error Resume Next
        For Each chkbx In ActiveSheet.CheckBoxes
            chkbx.Delete
        Next

                ' Deleting all columns from G to the right
                Range("G3").Select
                ActiveWorkbook.Sheets(1).Range(Columns("G:G"), Selection.End(xlToRight)).Select
                Selection.Delete Shift:=xlToLeft
                
        ' Resetting on Error event to default
                On Error GoTo 0

                ' If chosen, start sub 'Larger description of First Attribute changes, name it'
                If FirstOptionLogical Then Call RunFirstOptionSub ' Name of the Sub

                ' If chosen, start sub 'Larger description of Second Attribute changes, name it'
                If SecondOptionLogical Then Call RunSecondOptionSub ' Name of the Sub

                ' If chosen, start sub 'Larger description of Third Second Attribute changes, name it'
                If ThirdOptionLogical Then Call RunThirdOptionSub ' Name of the Sub

            Else
                
                If Ans0 = vbNo Then
            
                End If
            
            End If
            
            Exit Sub
            
    End Select

    cbx.TopLeftCell.Offset(, 2).Interior.Color = IIf(cbx.Value = xlOn, vbGreen, vbRed)
    'MsgBox cbx.Caption & vbCr & IIf(cbx.Value = xlOn, " is ", " is not ") & "chosen"
    
Exit Sub
    
CheckBoxHandlingERROR:
   MsgBox "Something went wrong... ;-) in the Sub CheckBoxHandling", vbCritical + vbOKOnly

End Sub

Sub RunFirstOptionSub()
' CODE
End Sub

Sub RunSecondOptionSub()
' CODE
End Sub

Sub RunThirdOptionSub()
' CODE
End Sub

Sub MacroWithOptionsEndsWithoutATrace()

FirstOptionLogical = False
SecondOptionLogical = False
ThirdOptionLogical = False

' OPTIONAL: Delete all remaining checkboxes, if any (most important when testing macro)

On Error Resume Next
For Each chkbx In ActiveSheet.CheckBoxes
    chkbx.Delete
Next

' Resetting on Error event to default
On Error GoTo 0

CheckBOxAdding

End Sub