Необязательные макросы с использованием сменных флажков

Question

каждый.

Благодаря этим инструкциям Как динамически назначить макрокоманду с помощью VBA https://social.msdn.microsoft.com/Forums/office/en-US/877f15da-bbe4-4026-8ef2-8df77e1022f7/how-do-i-assign-a-macro-to-a-checkbox-dynamically-using-vba?forum=exceldev

У меня возникла идея:

1. Поставьте флажки там, где я хочу, на листе, например, в столбцах справа от таблицы с данными для обработки
2. Соедините их (не) проверку с логическими переменными, которые используются, чтобы запускать или не запускать некоторые процедуры.
3. Подождите, пока пользователь сделает свой выбор, и установите флажок (например, последний в списке), чтобы запустить выбранные процедуры.
4. Снимите все (!) Флажки и запустите процедуры, выбранные незадолго до этого. Таким образом, макросы, содержащие необязательные процедуры, являются переносимыми, поскольку они не зависят от открытых файлов, а только работают с ними. Сами файлы остаются неизменными благодаря этим свободным от кнопок управления, закодированным в макросе (т. Е. Лист с флажками возвращается в свое предыдущее состояние).

Пример: следующий макрос создает свои собственные флажки (в столбце 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 "Kliknut je box sa opcijom" & 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 "Kliknut je box sa opcijom" & 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

Делись и используй по своему усмотрению, так как я использовал чужие знания и опыт. Мне очень жаль, но я не нашел другого решения, чтобы представить это вам, и я также не нашел никого, кто бы представлял что-то похожее на это.