Код VBA для выбора нескольких выпадающих опций, не работающих на защищенном листе - PullRequest
0 голосов
/ 08 марта 2019

Я использую следующий код, чтобы разрешить множественный выбор в раскрывающихся списках в ячейках, но код перестает работать, если я защищаю лист. Вместо добавления последующих кликов, разделенных запятой, он просто заменяет исходный выбор.

Целевые ячейки не заблокированы, но все еще не работает. Есть идеи?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If ActiveSheet.Cells(3, Target.Column) = "MS" 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
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

1 Ответ

0 голосов
/ 08 марта 2019

Это будет работать на защищенном листе:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Oldvalue As String, Newvalue As String

    If Target.CountLarge > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Me.Cells(3, Target.Column) <> "MS" Then Exit Sub

    On Error GoTo Exitsub
    If HasValidation(Target) Then

        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        If Oldvalue = "" Then
            Target.Value = Newvalue
        ElseIf InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
        Else
            Target.Value = Oldvalue
        End If
        Application.EnableEvents = True

    End If

Exitsub:
    Application.EnableEvents = True
End Sub

Function HasValidation(cell As Range) As Boolean
    Dim t: t = Null

    On Error Resume Next
    t = cell.Validation.Type
    On Error GoTo 0

    HasValidation = Not IsNull(t)
End Function

Функция взята из ответа AgentRev здесь: Определите, содержит ли ячейка подтверждение данных

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...