Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/работа 2х разных Private Sub Worksheet_SelectionChange - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » работа 2х разных Private Sub Worksheet_SelectionChange (Макросы/Sub)
работа 2х разных Private Sub Worksheet_SelectionChange
Leika Дата: Суббота, 09.01.2016, 09:55 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброе утро!
Не удалось найти ответ на мой вопрос в других темах форума, поэтому создаю новую тему.
Вопрос, наверное, очень не разумный, но он есть.
Суть вопроса, 2 разных макроса, которые по отдельности (на разных листах) работают, а вместе нет.
Как я понимаю, проблема в том, что в них содержится повторяющаяся команда "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" и ошибку выдает именно на эту строку.
Если завершаю первый макрос End If и прописываю второй (что ранее при других командах помогало), то начинает выдавать ошибку именно на строку завершения.

Первый команда это всплывающие окно поиска по форме

[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect([Q:Q], Target) Is Nothing Or Target.Address = "$Q$1" Then Exit Sub
Cancel = True
With Target.Application.ActiveWindow
UserForm1.Left = (Target.Left + Target.Width - .VisibleRange.Left) * .Zoom / 100 + .Application.Left + 25
UserForm1.Top = (Target.Top + UserForm1.Height / 2) * .Zoom / 100 + .Application.Top
UserForm1.Show 0
End With
End Sub

Private Sub Worksheet_Deactivate()
Unload UserForm1
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect([Q:Q], Target) Is Nothing Or Target.Count > 1 Then Unload UserForm1
End Sub
[/vba]

Вторая команда это выделение текста

[vba]
Код
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("A2:AB1000") 'адрес рабочего диапазона, в пределах которого видно выделение
Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select 'формируем крестообразный диапазон и выделяем
Target.Activate
End Sub
[/vba]
как это можно исправить?


Сообщение отредактировал Leika - Суббота, 09.01.2016, 10:36
 
Ответить
СообщениеДоброе утро!
Не удалось найти ответ на мой вопрос в других темах форума, поэтому создаю новую тему.
Вопрос, наверное, очень не разумный, но он есть.
Суть вопроса, 2 разных макроса, которые по отдельности (на разных листах) работают, а вместе нет.
Как я понимаю, проблема в том, что в них содержится повторяющаяся команда "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" и ошибку выдает именно на эту строку.
Если завершаю первый макрос End If и прописываю второй (что ранее при других командах помогало), то начинает выдавать ошибку именно на строку завершения.

Первый команда это всплывающие окно поиска по форме

[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect([Q:Q], Target) Is Nothing Or Target.Address = "$Q$1" Then Exit Sub
Cancel = True
With Target.Application.ActiveWindow
UserForm1.Left = (Target.Left + Target.Width - .VisibleRange.Left) * .Zoom / 100 + .Application.Left + 25
UserForm1.Top = (Target.Top + UserForm1.Height / 2) * .Zoom / 100 + .Application.Top
UserForm1.Show 0
End With
End Sub

Private Sub Worksheet_Deactivate()
Unload UserForm1
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect([Q:Q], Target) Is Nothing Or Target.Count > 1 Then Unload UserForm1
End Sub
[/vba]

Вторая команда это выделение текста

[vba]
Код
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("A2:AB1000") 'адрес рабочего диапазона, в пределах которого видно выделение
Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select 'формируем крестообразный диапазон и выделяем
Target.Activate
End Sub
[/vba]
как это можно исправить?

Автор - Leika
Дата добавления - 09.01.2016 в 09:55
МВТ Дата: Суббота, 09.01.2016, 10:01 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 476
Репутация: 137 ±
Замечаний: 0% ±

Excel 2007
Сложно судить, без приложенного файла примера, но попробую предположить, что Вы записали макросы событий не в модули разных листов - каждый из ни должен быть записан в код именно того листа, события с которого он обрабатывает
 
Ответить
СообщениеСложно судить, без приложенного файла примера, но попробую предположить, что Вы записали макросы событий не в модули разных листов - каждый из ни должен быть записан в код именно того листа, события с которого он обрабатывает

Автор - МВТ
Дата добавления - 09.01.2016 в 10:01
Leika Дата: Суббота, 09.01.2016, 10:06 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
прошу прощения и исправляюсь. файл во вложении.
они должны работать на одном листе и , вроде, записаны в модуль 1 листа.
К сообщению приложен файл: 6250559.xlsm (21.1 Kb)
 
Ответить
Сообщениепрошу прощения и исправляюсь. файл во вложении.
они должны работать на одном листе и , вроде, записаны в модуль 1 листа.

Автор - Leika
Дата добавления - 09.01.2016 в 10:06
МВТ Дата: Суббота, 09.01.2016, 10:19 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 476
Репутация: 137 ±
Замечаний: 0% ±

Excel 2007
У Вас два макроса с одинаковыми названиями в модуле одного листа - так быть не может. Их надо объединить в один, примерно так, если я правильно понял
[vba]
Код
'îñíîâíàÿ ïðîöåäóðà, âûïîëíÿþùàÿ âûäåëåíèå
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect([Q:Q], Target) Is Nothing Or Target.Count > 1 Then Unload UserForm1
    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("A2:AB1000")    'àäðåñ ðàáî÷åãî äèàïàçîíà, â ïðåäåëàõ êîòîðîãî âèäíî âûäåëåíèå
    Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select   'ôîðìèðóåì êðåñòîîáðàçíûé äèàïàçîí è âûäåëÿåì
    Target.Activate
End Sub
[/vba]
 
Ответить
СообщениеУ Вас два макроса с одинаковыми названиями в модуле одного листа - так быть не может. Их надо объединить в один, примерно так, если я правильно понял
[vba]
Код
'îñíîâíàÿ ïðîöåäóðà, âûïîëíÿþùàÿ âûäåëåíèå
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect([Q:Q], Target) Is Nothing Or Target.Count > 1 Then Unload UserForm1
    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("A2:AB1000")    'àäðåñ ðàáî÷åãî äèàïàçîíà, â ïðåäåëàõ êîòîðîãî âèäíî âûäåëåíèå
    Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select   'ôîðìèðóåì êðåñòîîáðàçíûé äèàïàçîí è âûäåëÿåì
    Target.Activate
End Sub
[/vba]

Автор - МВТ
Дата добавления - 09.01.2016 в 10:19
Leika Дата: Суббота, 09.01.2016, 10:30 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
все равно ошибка.
до этого побывала прописывать вот так вот:

[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect([Q:Q], Target) Is Nothing Or Target.Count > 1 Then Unload UserForm1
End If

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("A2:AB1000") 'адрес рабочего диапазона, в пределах которого видно выделение
Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select 'формируем крестообразный диапазон и выделяем
Target.Activate
End Sub
[/vba]
тоже ошибка (


Сообщение отредактировал Leika - Суббота, 09.01.2016, 10:45
 
Ответить
Сообщениевсе равно ошибка.
до этого побывала прописывать вот так вот:

[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect([Q:Q], Target) Is Nothing Or Target.Count > 1 Then Unload UserForm1
End If

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("A2:AB1000") 'адрес рабочего диапазона, в пределах которого видно выделение
Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select 'формируем крестообразный диапазон и выделяем
Target.Activate
End Sub
[/vba]
тоже ошибка (

Автор - Leika
Дата добавления - 09.01.2016 в 10:30
RAN Дата: Суббота, 09.01.2016, 10:39 | Сообщение № 6
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
А кто будет макросу объяснять, что такое
[vba]
Код
Coord_Selection
[/vba]
Уж если вы используете чужие макросы, используйте код полностью.


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеА кто будет макросу объяснять, что такое
[vba]
Код
Coord_Selection
[/vba]
Уж если вы используете чужие макросы, используйте код полностью.

Автор - RAN
Дата добавления - 09.01.2016 в 10:39
Leika Дата: Суббота, 09.01.2016, 10:48 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
RAN, здравствуйте. Замечание принято, уж если и использую, то использую полностью.
Но к сожалению, проблему это не решает. ошибка та же и там же.
 
Ответить
СообщениеRAN, здравствуйте. Замечание принято, уж если и использую, то использую полностью.
Но к сожалению, проблему это не решает. ошибка та же и там же.

Автор - Leika
Дата добавления - 09.01.2016 в 10:48
RAN Дата: Суббота, 09.01.2016, 11:12 | Сообщение № 8
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
строка
[vba]
Код
Dim Coord_Selection As Boolean   'глобальная переменная для вкл/выкл выделения
[/vba]
должна быть первой


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщениестрока
[vba]
Код
Dim Coord_Selection As Boolean   'глобальная переменная для вкл/выкл выделения
[/vba]
должна быть первой

Автор - RAN
Дата добавления - 09.01.2016 в 11:12
Leika Дата: Суббота, 09.01.2016, 12:33 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
RAN, спасибо большое. теперь почти работает.
ошибка теперь в том, что при включении макроса выделения крестообразного диапазона, таблица из второго макроса с поиском появляется при клике по любой ячейки, а должна только по столбцу Q.
К сообщению приложен файл: 6038004.xlsm (27.4 Kb)
 
Ответить
СообщениеRAN, спасибо большое. теперь почти работает.
ошибка теперь в том, что при включении макроса выделения крестообразного диапазона, таблица из второго макроса с поиском появляется при клике по любой ячейки, а должна только по столбцу Q.

Автор - Leika
Дата добавления - 09.01.2016 в 12:33
RAN Дата: Суббота, 09.01.2016, 13:59 | Сообщение № 10
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
должна только по столбцу Q.

Это вам только кажется.
[vba]
Код
Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select
[/vba]
Выделяет все ячейки в строке, в том числе и столбец Q.

[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range
    If Target.Cells.Count > 1 Then Unload UserForm1: Exit Sub    'если выделено больше 1 ячейки - выходим
    If Intersect([Q:Q], Target(1)) Is Nothing Then Unload UserForm1
    If Coord_Selection = False Then Exit Sub    'если выделение выключено - выходим
    Application.ScreenUpdating = False
    Set WorkRange = Range("A2:AB1000")    'адрес рабочего диапазона, в пределах которого видно выделение
    Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select    'формируем крестообразный диапазон и выделяем
    Target.Activate
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
должна только по столбцу Q.

Это вам только кажется.
[vba]
Код
Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select
[/vba]
Выделяет все ячейки в строке, в том числе и столбец Q.

[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range
    If Target.Cells.Count > 1 Then Unload UserForm1: Exit Sub    'если выделено больше 1 ячейки - выходим
    If Intersect([Q:Q], Target(1)) Is Nothing Then Unload UserForm1
    If Coord_Selection = False Then Exit Sub    'если выделение выключено - выходим
    Application.ScreenUpdating = False
    Set WorkRange = Range("A2:AB1000")    'адрес рабочего диапазона, в пределах которого видно выделение
    Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select    'формируем крестообразный диапазон и выделяем
    Target.Activate
End Sub
[/vba]

Автор - RAN
Дата добавления - 09.01.2016 в 13:59
Мир MS Excel » Вопросы и решения » Вопросы по VBA » работа 2х разных Private Sub Worksheet_SelectionChange (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!