excel多选选项列表VBA不在密码保护表上运行

Posted 2023-02-25

【中文标题】excel多选选项列表VBA不在密码保护表上运行

【英文标题】：excel multi-select pick list VBA doesnt run on password protect sheet

【发布时间】：2020-02-27 23:04:48

【问题描述】：

关于如何更改此设置以允许在受密码保护的工作表上运行多选而无需键入密码的任何想法？

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Oldvalue As String
Dim Newvalue As String
Dim num As Integer

On Error GoTo Exitsub

If Target.Address = "$H$29" Or Target.Address = "$H$33" Or Target.Address = "$H$37" Or Target.Address = "$H$42" Or Target.Address = "$H$58" Or Target.Address = "$H$59" Or Target.Address = "$H$60" Or Target.Address = "$H$63" Or Target.Address = "$H$65" Or Target.Address = "$M$29" Or Target.Address = "$M$33" Or Target.Address = "$M$37" Or Target.Address = "$M$42" Or Target.Address = "$M$58" Or Target.Address = "$M$59" Or Target.Address = "$M$60" Or Target.Address = "$M$63" Or Target.Address = "$M$65" Then
    If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
    Else: If Target.Value = "" Then GoTo Exitsub Else
        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        If Oldvalue = "" Then
            Target.Value = Newvalue
        Else
            num = InStr(Oldvalue, Newvalue)
            If num = 0 Then ' If the element selected isnt already on the selected list
              Target.Value = Oldvalue & ", " & Newvalue
            ElseIf num = 1 Then ' If the element is the first on the list
              If Len(Oldvalue) = Len(Newvalue) Then ' If the element is the only element selected
                Target.Value = Replace(Oldvalue, Newvalue, "")
              Else                                  ' If the element is not the only element selected
                Target.Value = Replace(Oldvalue, Newvalue & ", ", "")
              End If
            ElseIf num > 1 Then  ' If the element is not the first
              Target.Value = Replace(Oldvalue, ", " & Newvalue, "")
            End If
        End If
    End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

【问题讨论】：

注意到的第一件事：替换 If Target.Address = this or that or this or that 使用 If Intersect(Target, This, That, This, That)。不是问题 - 更多的是最佳实践

您的代码需要在进行任何更改之前取消对工作表的保护，然后在完成后重新保护它。尽管如此，如果工作表受到保护以防止更改，用户如何进行触发宏的更改？

用户只需单击上面提到的多选选项列表字段之一（即$h$29），宏允许他选择多个值。但是一旦我保护了工作表，它只会显示一个值。

取消注释您的错误处理程序并运行代码 - 它在哪里出错以及错误消息是什么？

只是不确定要添加什么以及在哪里插入 - 我尝试了一些仅用户界面的方法，但我可能插入不正确。

【参考方案1】：

SpecialCells(xlCellTypeAllValidation) 在受保护的工作表上引发错误

这将适用于受保护的工作表：

Private Sub Worksheet_Change(ByVal Target As Range)
    Const SEP As String = ","
    Dim c As Range, NewValue, OldValue, arr, v, lst, removed As Boolean

    On Error GoTo Exitsub

    If Target.CountLarge > 1 Then Exit Sub '<< only handling single-cell changes

    'is the changed cell in our monitored range?
    Set c = Application.Intersect(Target, Me.Range("B5,B7,B9,B11")) ' for example

    If Not c Is Nothing Then
        If Len(c.Value) > 0 And Not c.Validation Is Nothing Then

            Application.EnableEvents = False
            NewValue = c.Value
            Application.Undo
            OldValue = c.Value

            If OldValue = "" Then
                c.Value = NewValue
            Else
                arr = Split(OldValue, SEP)
                'loop over previous list, removing newvalue if found
                For Each v In arr
                    If v = NewValue Then
                        removed = True
                    Else
                        lst = lst & IIf(lst = "", "", SEP) & v
                    End If
                Next v
                'add the new value if we didn't just remove it
                If Not removed Then lst = lst & IIf(lst = "", "", SEP) & NewValue
                c.Value = lst
            End If
        End If    'has validation and non-empty
    End If        'handling this cell

Exitsub:
    If Err.Number <> 0 Then MsgBox Err.Description
    Application.EnableEvents = True
End Sub

【参考方案2】：

选项 1 取消保护工作表，运行您的代码，然后使用 VBA 再次保护它（但是当宏在中间停止时这可能是不安全的）

选项 2 使用此代码保护工作表

ActiveSheet.Protect "password", UserInterfaceOnly:=True

这样，工作表只能防止用户更改，而不是宏更改。

【讨论】：

工作表保护不是安全功能。