Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Объединение двух обработчиков в один
 
Код
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:E" & Cells(Rows.Count, 1).End(xlUp).Row)) Is Nothing Then
        rw = Target.Row
        If Selection.Address = "$A$" & rw & ":$M$" & rw Then
            With Sheets("Для бухг")
                Selection.copy .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
                Beep
            End With
        End If
    End If
End Sub

Dim Coord_Selection As Boolean 'глобальная переменная для вкл/выкл выделения

Код
Sub Selection_On() 'макрос включения выделения
Coord_Selection = True
End Sub

Sub Selection_Off() 'макрос выключения выделения
Coord_Selection = False
End Sub

'основная процедура, выполняющая выделение
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WorkRange As Range

If Target.Cells.Count > 1 Then Exit Sub 'если выделено больше 1 ячейки - выходим
If Coord_Selection = False Then Exit Sub 'если выделение выключено - выходим

Application.ScreenUpdating = False
Set WorkRange = Range("A1:AU10000") 'адрес рабочего диапазона, в пределах которого видно выделение
Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select 'формируем крестообразный диапазон и выделяем
Target.Activate
End Sub
Изменено: plohish - 2 Мар 2015 11:38:36 (Помогите объединить)
 
Если угадал..
Изменено: Маугли - 3 Мар 2015 04:52:50
Страницы: 1
Читают тему (гостей: 1)