ошибка при сравнении двух флажков в макросе vba

Question

У меня есть два флажка, первый флажок связан с первым человеком, а второй флажок связан со вторым человеком, который является рецензентом. Когда флажки установлены, он должен получить имя пользователя и текущее время. Кроме того, если установлен только первый флажок, лист не будет защищен, но если установлен второй флажок, лист должен быть защищен. это работает нормально.

но если я хочу поставить некоторые условия, как показано ниже, это дает ошибку.

Answer 1

Вот другой подход. Я поместил два флажка ActiveX на листе. Причина, по которой я использовал элементы управления ActiveX, заключается в том, что они имеют события, то есть код запускается при нажатии на них без назначения им макроса. Я удалил их подписи и назвал их ChkOwner и ChkManager . Они размещаются в столбце слева от поля Имя , которое, в свою очередь, находится слева от поля Дата / Время (легко настроить: ищите Смещение в коде ).

Код должен быть размещен на листе кодов, принадлежащем вкладке, на которой вы хотите выполнить действие. Убедитесь, что вы выбрали правильный лист, потому что в остальном код не будет иметь никакого эффекта.

Option Explicit

Private Sub Worksheet_Activate()
    SetProtection
End Sub

Private Sub ChkOwner_Click()
    SignTheDocument ChkOwner
End Sub

Private Sub ChkManager_Click()
    SignTheDocument ChkManager
    SetProtection
End Sub


Private Sub SignTheDocument(Chk As MSForms.CheckBox)

    Chk.TopLeftCell.Offset(0, 1).Value = IIf(Chk.Value, Application.UserName, vbNullString)
    Chk.TopLeftCell.Offset(0, 2).Value = IIf(Chk.Value, Now(), vbNullString)
End Sub

Private Sub SetProtection()

    With ActiveSheet
        If ChkManager.Value = True Then
            .Protect Password:="Secret", _
                     Contents:=True, _
                     UserInterfaceOnly:=True
        Else
            Unprotect "Secret"
        End If
    End With
End Sub

Первая процедура запускается, когда рабочий лист активирован. Вызывает процедуру SetProtection. Здесь вы можете указать объект защиты в деталях. Элемент, который я добавил - UserInterfaceOnly = True. Это означает, что код может вносить изменения, которые пользователь не может сделать из интерфейса рабочего листа. Если вы хотите сохранить пароль в секрете, добавьте защиту паролем в ваш проект VBA. Это отличается от защиты рабочего листа и рабочей книги и устанавливается в окне редактора VB.

Следующие две процедуры отвечают на щелчки по флажкам на рабочем листе. Они оба называют суб SignTheDocument, с которым они идентифицируют себя. Подпись добавляется или удаляется в зависимости от значения флажка. Если щелчок был на защите ChkManager , она также будет рассмотрена.

Просто и легко. Я думаю, что вы можете справиться с этим.

Answer 2

Попробуйте это. Я использовал два флажка с именами "chk_1" и "chk_2", оба связаны с макросом ниже.

Sub CheckBoxClicked()

    Const PW As String = "c1tc0"
    Const COL_NM As Long = 3
    Const COL_TM As Long = 4

    Dim cb1 As CheckBox, cb2 As CheckBox
    Dim cb1Row As Long, cb2Row As Long, cb1Checked As Boolean, cb2Checked As Boolean
    Dim cb1Clicked As Boolean, ws As Worksheet

    Set ws = ActiveSheet

    Set cb1 = ws.CheckBoxes("chk_1")
    cb1Row = cb1.TopLeftCell.Row
    cb1Checked = cb1.Value = xlOn

    Set cb2 = ws.CheckBoxes("chk_2")
    cb2Row = cb2.TopLeftCell.Row
    cb2Checked = cb2.Value = xlOn

    cb1Clicked = (Application.Caller = cb1.Name)

    ws.Unprotect PW 'default is unprotected

    'handle data entry/clearing
    If cb1Clicked Then
        ws.Cells(cb1Row, COL_NM).Value = IIf(cb1Checked, Environ("USERNAME"), Null)
        ws.Cells(cb1Row, COL_TM).Value = IIf(cb1Checked, Now, Null)
    Else
        ws.Cells(cb2Row, COL_NM).Value = IIf(cb2Checked, Environ("USERNAME"), Null)
        ws.Cells(cb2Row, COL_TM).Value = IIf(cb2Checked, Now, Null)
    End If

    'implement your protection rules here...
    If cb1Checked And cb2Checked Then
        ws.Protect PW
    ElseIf cb1Checked And Not cb2Checked Then
        'no reprotect?
    ElseIf Not cb1Checked And cb2Checked Then
        ws.Protect PW
    ElseIf Not cb1Checked And Not cb2Checked Then
        'no reprotect
    End If

End Sub