Excel VBA объединяет два изменения рабочего листа - PullRequest
1 голос
/ 26 января 2020

Можете ли вы помочь мне объединить эти два изменения листа? Я хотел бы применить прописные буквы для диапазона и запретить любое копирование / вставку.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim UndoList As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    On Error GoTo ErrExit
    UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
    If Left(UndoList, 5) = "Paste" Or UndoList = "Auto Fill" Then
        MsgBox "Copy / paste is not permitted" & vbCr & _
               "- Creator"
        With Application
            .Undo
            .CutCopyMode = False
        End With
        Target.Select
    End If

ErrExit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Выше - предотвращение копирования / прошествия, а ниже - верхний регистр.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not (Application.Intersect(Target, Range("AB26:QE124")) _
      Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
End Sub

1 Ответ

2 голосов
/ 26 января 2020

Итак, соблюдая условие сделать UpperCase только для ячеек в Range("AB26:QE124"), вы можете использовать следующий объединенный код:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim UndoList As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    On Error GoTo ErrExit
    UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
    If left(UndoList, 5) = "Paste" Or UndoList = "Auto Fill" Then
        MsgBox "Copy / paste is not permitted" & vbCr & _
               "- Creator"
        With Application
            .Undo
            .CutCopyMode = False
        End With
        Target.Select
    End If

    'The UperCase part______________________________________________
    If Not (Application.Intersect(Target, Range("AB26:QE124")) _
                                                    Is Nothing) Then
        With Target
            If Not .HasFormula Then
                Application.EnableEvents = False
                .Value = UCase(.Value)
                Application.EnableEvents = True
            End If
        End With
    End If
    '_______________________________________________________________

ErrExit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...