Excel VBA для автоматической прописной буквы вызывает ошибку при вставке

Question

Приведенный ниже код вызывает ошибку при вставке информации на лист.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A1 As Range
    Set A1 = Range("A:I")
    If Not Intersect(Target, A1) Is Nothing Then
        Application.EnableEvents = False
            Target.Value = UCase(Target.Value)
        Application.EnableEvents = True
    End If
End Sub

Код относится к листу (щелкните правой кнопкой мыши на вкладке код вида).

Не могли бы вы посоветовать, как это исправить?

Заранее спасибо.

Answer 1

Ошибка из-за Target.Value = UCase(Target.Value) не подходит для нескольких ячеек.Таким образом, необходим цикл:

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo WorksheetChange_Error

    Application.EnableEvents = False
    Dim A1 As Range
    Set A1 = Range("A:I")

    If Not Intersect(Target, A1) Is Nothing Then
            Dim myCell As Range
            For Each myCell In Target.Cells
                myCell = UCase(myCell)
            Next
    End If
    Application.EnableEvents = True
    Exit Sub

WorksheetChange_Error:

    Application.EnableEvents = True
    MsgBox Err.Description

End Sub

Обработчик ошибок используется для сброса EnableEvents = True, если возникает какая-то непредвиденная ошибка.

Answer 2

Обведите ячейки пересечения, если они существуют:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A1 As Range, intr As Range, r As Range
    Set A1 = Range("A:I")
    Set intr = Intersect(A1, Target)
    If Not intr Is Nothing Then
        Application.EnableEvents = False
            For Each r In intr
                r.Value = UCase(r.Value)
            Next r
        Application.EnableEvents = True
    End If
End Sub