Запуск нескольких Private Sub Worksheet_SelectionChange

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Запуск нескольких Private Sub Worksheet_SelectionChange (Макросы/Sub)

Дата: Среда, 18.11.2015, 16:43 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Добрый день

Подскажите пожалуйста как сделать несколько независимо работающих Private Sub Worksheet_SelectionChange на одном листе. Пример:

[vba]

Код

Private Sub Worksheet_SelectionChange(ByVal target As Range) 'Signs protection
If IsEmpty (Range("W3")) Then
If Intersect (target, Range("W3")) Is Nothing Then Exit Sub
UserForm2.Show

If IsEmpty (Range("S29")) Then
If Intersect (target, Range("S29")) Is Nothing Then Exit Sub
UserForm3.Show

Else
If Intersect (target, Range("e76,G76,e78,g78,U76,u78,x76,x78")) Is Nothing Then Exit Sub
MsgBox "Access Denied!"
Range("A77").Select
End If
End If

End Sub

[/vba]

Если делаю так как указано, то 3 условие работает только после того как вставлено значение в ячейку "W3".
Условие 2 вообще не реагирует.
Если перед каждым условием поставить ELSE то тогда работают все по очереди.
А необходимо чтобы работали независимо.

Заранее спасибо
[moder]Для оформления кода есть кнопка #. Исправила[/moder]

Сообщение отредактировал Pelena - Среда, 18.11.2015, 16:48

Ответить

Manyasha

Дата: Среда, 18.11.2015, 17:08 | Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 902 ±

Замечаний: 0% ±

Excel 2010, 2016

SK, а если я выделяю диапазон D3:X78, нужно выводить и 2 формы и сообщение?
Так подойдет?
[vba]

Код

Private Sub Worksheet_SelectionChange(ByVal target As Range)
'Если при выборе более 1-й ячейки не нужно проверять условия,
'раскомменитровать следующую строчку
'    If target.Count > 1 Then Exit Sub 'если выделено больше 1 ячейки - выходим

    If IsEmpty(Range("W3")) And Not Intersect(target, Range("W3")) Is Nothing Then
        UserForm2.Show
    End If
    If IsEmpty(Range("S29")) And Not Intersect(target, Range("S29")) Is Nothing Then
        UserForm3.Show
    End If
    If Not Intersect(target, Range("e76,G76,e78,g78,U76,u78,x76,x78")) Is Nothing Then
        MsgBox "Access Denied!"
        Range("A77").Select
    End If
End Sub

[/vba]

ЯД: 410013299366744 WM: R193491431804

Ответить

_Boroda_

Дата: Среда, 18.11.2015, 17:08 | Сообщение № 3

Группа: Админы

Ранг: Местный житель

Сообщений: 17006

Репутация: 6667 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Перепишите первый блок так (я не люблю делать в if сразу несколько условий - хоть код и получается длиннее, зато прозрачнее и быстрее)
[vba]

Код

If IsEmpty(Range("W3")) Then
    If Not Intersect(target, Range("W3")) Is Nothing Then
        UserForm2.Show
    End If
End If

[/vba]
Остальные аналогично.

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Пятница, 20.11.2015, 09:39 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Переписал код.
не получается сделать так чтобы MAcros2 работал не зависимо от Macros1

[vba]

Код

Private Sub Worksheet_SelectionChange(ByVal target As Range) 'Signs protection

If Intersect(target, Range("w3,w21,s29,e62,t73")) Is Nothing Then Exit Sub ' Macros1
UserForm1.Show

If Intersect(target, Range("e76,G76,e78,g78,U76,u78,x76,x78")) Is Nothing Then Exit Sub 'Macros2
MsgBox "Access denied!"
Range("A77").Select

End Sub

[/vba]

Сообщение отредактировал SK - Пятница, 20.11.2015, 09:41

Ответить

RAN

Дата: Пятница, 20.11.2015, 10:38 | Сообщение № 5

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

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

Быть или не быть, вот в чем загвоздка!

Ответить

Дата: Пятница, 20.11.2015, 11:56 | Сообщение № 6

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Всем спасибо заработало

Ответить

Запуск нескольких Private Sub Worksheet_SelectionChange (Макросы/Sub)

Страница 1 из 1
1