Мне нужно показать сообщение «Пожалуйста, выберите максимум 8 данных».когда пользователь выбрал более 8 ячеек на листе - PullRequest
Новая
       3

Мне нужно показать сообщение «Пожалуйста, выберите максимум 8 данных».когда пользователь выбрал более 8 ячеек на листе

0 голосов
/ 07 февраля 2019

Таким образом, максимально допустимое количество данных для копирования на другом листе равно 8. Каждый раз, когда пользователь выбирает более 8 данных, возникает ошибка.Как я могу показать свой собственный msgbox вместо стандартного msgbox, предоставляемого VBA.

Я совершенно новичок в VBA.

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

Sub CopySelectedCells()

    On Error GoTo EncounteredError

        Worksheets("3inch_OD7133KS ").Activate
        Selection.Resize(, 4).Copy Destination:=Worksheets("Form").Range("b7")
        Selection.Resize(, 4).Copy Destination:=Worksheets("Form").Range("b27")
        Selection.Resize(, 4).Copy Destination:=Worksheets("Form").Range("b47")

    Exit Sub

EncounteredError:

    MsgBox "ERROR OCCURED: Please choose a MAXIMUM of 8 data."


End Sub

1 Ответ

0 голосов
/ 07 февраля 2019

On Error GoTo Handler обычно считается плохой практикой.Вы должны всегда стараться по возможности кодировать ожидаемые ошибки для большей надежности.В этом случае мы можем просто проверить размер .Selection , прежде чем предпринимать какие-либо действия, используя .Rows.Count и .Columns.Count.Нам нужно ограничить сабвуфер работать только тогда, когда он возвращает диапазон 8 x 1.

Если это все, что делает ваш саб, то это должно быть хорошо .... 

Sub Selections()

If Selection.Rows.Count <> 8 Or Selection.Columns.Count <> 1 Then
    MsgBox "Error Message Here"
    Exit Sub
Else
    Selection.Resize(, 4).Copy
        With Worksheets("3inch_OD7133KS ")
            .Range("B7").PasteSpecial xlPasteValues
            .Range("B27").PasteSpecial xlPasteValues
            .Range("B47").PasteSpecial xlPasteValues
        End With
End If

End Sub

Если у вас есть дополнительный код для добавления после проверки размера выбранного диапазона, вы можете вложить свой тест следующим образом ... 

Sub Selections()

If Selection.Rows.Count <> 8 Or Selection.Columns.Count <> 1 Then
    MsgBox "Error Message Here"
    Exit Sub
End If

Selection.Resize(, 4).Copy
    With Worksheets("Sheet1")
        .Range("B7").PasteSpecial xlPasteValues
        .Range("B27").PasteSpecial xlPasteValues
        .Range("B47").PasteSpecial xlPasteValues
    End With

'More code here....

End Sub
...