Процедура Worksheet_BeforeDoubleClick для нескольких ячеек - Мир MS Excel

Регистрация

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

= Мир MS Excel/Процедура Worksheet_BeforeDoubleClick для нескольких ячеек - Мир MS Excel

Старая форма входа

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Процедура Worksheet_BeforeDoubleClick для нескольких ячеек (Макросы/Sub)

Процедура Worksheet_BeforeDoubleClick для нескольких ячеек

Дата: Пятница, 03.10.2014, 06:35 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 109

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

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

Excel 2010

Добрый день!
Подскажите, пожалуйста, можно ли выполнить процедуру Worksheet_BeforeDoubleClick на листе для нескольких (две и более) ячеек?
Например, есть таблица, разделенная на разделы. По двойному клику на ячейке, принадлежащей соответствующему разделу, добавляется N-ое количество строк. Имеется макрос для добавления строк (шаблона). Можно ли задать его выполнение для трёх ячеек на листе, путем двойного клика на выбранной ячейке? Файл прилагаю.
[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("имя1")) Is Nothing Then
  ....
ActiveSheet.Range("шаблон1").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False
....
End Sub

[/vba]

К сообщению приложен файл: 1153197.xlsm (18.8 Kb)

Ответить

Дата: Пятница, 03.10.2014, 07:43 | Сообщение № 2

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

Ранг: Участник клуба

Сообщений: 2525

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

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

2010

А так нельзя разве было

Код

If Not Intersect(Target, Range("B10,B15,B20")) Is Nothing Then

обязательно имена присваивать? Или что то не так понял?

ЯД-41001506838083

Сообщение отредактировал gling - Пятница, 03.10.2014, 07:43

Ответить

Дата: Пятница, 03.10.2014, 08:04 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 109

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

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

Excel 2010

Цитата gling, 03.10.2014 в 07:43, в сообщении № 2

обязательно имена присваивать?

Так как шаблон, при его добавлении между строками разделов (закрашены в файле зеленной заливкой), будет смещать эти строки и у них будет меняться адрес, то думаю нужно указывать имя ячейки.

Ответить

Дата: Пятница, 03.10.2014, 08:05 | Сообщение № 4

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 109

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

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

Excel 2010

Цитата gling, 03.10.2014 в 07:43, в сообщении № 2

Или что то не так понял?

Проблема в том, что шаблоны разные, а не один для всех разделов.

Ответить

Дата: Пятница, 03.10.2014, 08:23 | Сообщение № 5

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

Ранг: Участник клуба

Сообщений: 3209

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

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

2003

Ввод фразы "С работы загружать файлы с макросами не могу (спасибо собакам-сисадминам)" мне, наверное, нужно в подпись добавить

Абсолютно верно сказал gling. Нужно просто внутри скобок после Intersect перечислить диапазоны или их имена через запятую.
Только чтобв по даблклику по ячейкам этих диапазонов не входить в режим редактирования ячейки, нужно после Intersect добавить ещё одну команду: Cancel = True

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Пятница, 03.10.2014, 08:31 | Сообщение № 6

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

Ранг: Участник клуба

Сообщений: 3209

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

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

2003

Хотя... Поспешил.
Диапазоны-аргументы нужно, наверное, сначала объединить, используя Union, в один диапазон, а потом уже вставлять в Intersect.
Типа [vba]

Код

Dim rTemp As Range
Set rTemp = Union("XXXX", "YYYY", "ZZZ")
If Not Intersect (rTemp, Target) Is Nothing Then
Cancel = True
…

[/vba]
Не уверен, сработает ли сразу без промежуточного объединения (кажется, были в некоторых случаях проблемы)[vba]

Код

If Not Intersect (Union("XXXX", "YYYY", "ZZZ", Target) Is Nothing Then
Cancel = True
…

[/vba] , но ведь попробовать никто не мешает.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Пятница, 03.10.2014, 08:37

Ответить

Дата: Пятница, 03.10.2014, 08:39 | Сообщение № 7

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 109

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

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

Excel 2010

Alex_ST, и снова здравствуйте!

Цитата Alex_ST, 03.10.2014 в 08:31, в сообщении № 6

сначала объединить, используя Union, а потом уже вставлять в Intersect.
Не уверен, сработает ли Intersect (Union("XXXX", "YYYY", "ZZZ", Target) , но ведь попробовать никто не мешает.

Моя не понимать.

Можете поправить мой код. Пожа-ааа-луйста!

Сообщение отредактировал Лорик - Пятница, 03.10.2014, 08:40

Ответить

Дата: Пятница, 03.10.2014, 08:44 | Сообщение № 8

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

Ранг: Участник клуба

Сообщений: 3209

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

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

2003

А ЭТОГО разве не достаточно? Посмотрите, я там сразу после написания подправил - ввёл примеры кодов.
А по поводу "подправить" Ваш макрос, я уде писАл:

Цитата Alex_ST, 03.10.2014 в 08:23, в сообщении № 5

"С работы загружать файлы с макросами не могу (спасибо собакам-сисадминам)"

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Пятница, 03.10.2014, 08:46

Ответить

Дата: Пятница, 03.10.2014, 09:00 | Сообщение № 9

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 109

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

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

Excel 2010

Цитата Alex_ST, 03.10.2014 в 08:44, в сообщении № 8

Посмотрите,

Ничего не работает....

Ответить

Дата: Пятница, 03.10.2014, 09:09 | Сообщение № 10

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

Ранг: Участник клуба

Сообщений: 3209

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

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

2003

Ну, подумаешь, маленько со скобками наврал, т.к. прямо в форум писАл

Могли бы и сами подправить
Вот так точно работает:[vba]

Код

If Not Intersect(Union([XXXX], [YYYY], [ZZZZ]), Target) Is Nothing Then
Cancel = True

[/vba]
Ну, или в "классическом, по учебникам" написании:[vba]

Код

If Not Intersect(Union(Range("XXXX"), Range("YYYY"), Range("ZZZZ")), Target) Is Nothing Then
Cancel = True

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Пятница, 03.10.2014, 09:13

Ответить

Дата: Пятница, 03.10.2014, 09:20 | Сообщение № 11

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 109

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

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

Excel 2010

Так нужно?

[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rTemp As Range
If Not Intersect(Union([XXXX], [YYYY], [ZZZZ]), Target) Is Nothing Then
Cancel = True

    ActiveSheet.Range("шаблон").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False
....
End If
End Sub

[/vba]
Что означаю XXXX, YYYY, ZZZZ? Имена моих ячеек?

Ответить

Дата: Пятница, 03.10.2014, 09:47 | Сообщение № 12

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

Ранг: Участник клуба

Сообщений: 3209

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

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

2003

Цитата Лорик, 03.10.2014 в 09:20, в сообщении № 11

Что означаю XXXX, YYYY, ZZZZ? Имена моих ячеек?

Ну, естественно

Я же не могу открыть Ваш файл и посмотреть. Поэтому имена взял с потолка.
Ну и свою процедуру уж приведите в один стиль написания. Не по фэншую мешать стили.
Уж либо везде в квадраьных скобках [XXXX] , либо везде Range("XXXX")

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Пятница, 03.10.2014, 10:10 | Сообщение № 13

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 109

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

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

Excel 2010

Alex_ST, вот, что получилось...
[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rTemp As Range
If Not Intersect(Union(Range("имя1"), Range("имя2"), Range("имя3")), Target) Is Nothing Then
Cancel = True
     ActiveSheet.Range("шаблон").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False

     ActiveSheet.Range("шаблон2").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False

     ActiveSheet.Range("шаблон3").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False

End If
End Sub

[/vba]

... но работает не так как я хотела. Вопрос был в следующем, чтобы при двойном клике на ячейку с наименованием первого раздела, добавлялись строки (шаблон строк) в ПЕРВЫЙ раздел, при двойном клике на ячейку второго раздела, добавлялся шаблон ВТОРОГО раздела, и аналогично третий раздел. В Вашем случае при двойном клике на ячейку любого из разделов добавляются шаблоны СРАЗУ во все разделы. (прим. ШАБЛОНЫ для разделов разные). Может не правильно все таки слепила код или данная процедура не будет работать при таких условиях?!

Alex_ST, вот, что получилось...
[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rTemp As Range
If Not Intersect(Union(Range("имя1"), Range("имя2"), Range("имя3")), Target) Is Nothing Then
Cancel = True
     ActiveSheet.Range("шаблон").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False

     ActiveSheet.Range("шаблон2").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False

     ActiveSheet.Range("шаблон3").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False

End If
End Sub

[/vba]

... но работает не так как я хотела. Вопрос был в следующем, чтобы при двойном клике на ячейку с наименованием первого раздела, добавлялись строки (шаблон строк) в ПЕРВЫЙ раздел, при двойном клике на ячейку второго раздела, добавлялся шаблон ВТОРОГО раздела, и аналогично третий раздел. В Вашем случае при двойном клике на ячейку любого из разделов добавляются шаблоны СРАЗУ во все разделы. (прим. ШАБЛОНЫ для разделов разные). Может не правильно все таки слепила код или данная процедура не будет работать при таких условиях?!Лорик

Ответить

СообщениеAlex_ST, вот, что получилось...
[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim rTemp As Range
If Not Intersect(Union(Range("имя1"), Range("имя2"), Range("имя3")), Target) Is Nothing Then
Cancel = True
     ActiveSheet.Range("шаблон").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False

     ActiveSheet.Range("шаблон2").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False

     ActiveSheet.Range("шаблон3").Select
     ActiveSheet.Unprotect
     Selection.Copy
     Selection.Insert Shift:=xlDown
     Selection.ClearComments
     Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 2)).Select
     Selection.Interior.ColorIndex = 0
     ActiveCell.Offset(-1, 0).Activate
     ActiveCell.Offset(1, 0).Activate
     Application.CutCopyMode = False

End If
End Sub

[/vba]

... но работает не так как я хотела. Вопрос был в следующем, чтобы при двойном клике на ячейку с наименованием первого раздела, добавлялись строки (шаблон строк) в ПЕРВЫЙ раздел, при двойном клике на ячейку второго раздела, добавлялся шаблон ВТОРОГО раздела, и аналогично третий раздел. В Вашем случае при двойном клике на ячейку любого из разделов добавляются шаблоны СРАЗУ во все разделы. (прим. ШАБЛОНЫ для разделов разные). Может не правильно все таки слепила код или данная процедура не будет работать при таких условиях?!

Автор - Лорик
Дата добавления - 03.10.2014 в 10:10

Дата: Пятница, 03.10.2014, 10:18 | Сообщение № 14

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

Ранг: Участник клуба

Сообщений: 3209

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

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

2003

Чтобы обратиться к листу, на котором расположен именованный диапазон, нужно использовать свойство .Parent.
Например, снять защиту с листа, на котором расположен диапазон "шаблон":[vba]

Код

[шаблон].Parent.Unprotect

[/vba]или просто перейти на лист:[vba]

Код

[шаблон].Parent.Select

[/vba]
-------------------------------------
Без файла, похоже, не разобраться...
Где, какой именованный диапазон расположен?
У Вас что, лист, где расположен диапазон "шаблон" запаролен? Или это не имя диапазона, а имя запароленного листа?
А на этом листе - именованные диапазоны "имя1", "имя2", имя3", в которых шаблоны для вставки в соответствующие разделы?

С уважением,
Алексей
MS Excel 2003 - the best!!!

Сообщение отредактировал Alex_ST - Пятница, 03.10.2014, 10:30

Ответить

Дата: Пятница, 03.10.2014, 10:30 | Сообщение № 15

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

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

Сообщений: 5660

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

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

2010

[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     If Target.Count > 1 Then Exit Sub
     Select Case Val(Target.EntireRow.Cells(1))
     Case 1, 2, 3
         Rows(Target.Row + 1 & ":" & Target.Row + 4).Insert
         Rows(Target.Row + 1 & ":" & Target.Row + 4).Interior.Pattern = xlNone
     End Select
     Cancel = True
End Sub

[/vba]
Даблклик по любой ячейке строки, содержащей порядковые номера 1-3.

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

Ответить

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

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 109

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

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

Excel 2010

Цитата Alex_ST, 03.10.2014 в 10:18, в сообщении № 14

снять защиту с листа

Лист не защищен. Все шаблоны и именные ячейки находятся на одном листе. Код процедуры размещен в модуле листа.

Ответить

Дата: Пятница, 03.10.2014, 10:46 | Сообщение № 17

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 109

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

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

Excel 2010

Цитата RAN, 03.10.2014 в 10:30, в сообщении № 15

Даблклик по любой ячейке строки, содержащей порядковые номера 1-3.

RAN, добавляются новые ПУСТЫЕ строки, но мне нужно чтобы добавлялись строки ШАБЛОНОВ. При нескольких видах Реагентов, ГСМ, Материалов, нужно добавлять дополнительные строки (наименование, расход, цена, затраты), в виде того шаблона, который указан в каждом разделе.

Ответить

Дата: Пятница, 03.10.2014, 10:48 | Сообщение № 18

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

Ранг: Участник клуба

Сообщений: 3209

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

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

2003

Цитата Лорик, 03.10.2014 в 10:38, в сообщении № 16

Лист не защищен

но при этом Вы пишете:

Цитата Лорик, 03.10.2014 в 10:10, в сообщении № 13

ActiveSheet.Unprotect

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Дата: Пятница, 03.10.2014, 10:55 | Сообщение № 19

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

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

Сообщений: 5660

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

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

2010

[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     If Target.Count > 1 Then Exit Sub
     Select Case Val(Target.EntireRow.Cells(1))
     Case 1, 2, 3
         Rows(Target.Row + 1 & ":" & Target.Row + 4).Copy
         Rows(Target.Row + 1).Insert
         Cells(Target.Row, 4).Offset(1).Resize(3, 6).ClearContents
         Application.CutCopyMode = False
     End Select
     Cancel = True
End Sub

[/vba]

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

Ответить

Дата: Пятница, 03.10.2014, 10:58 | Сообщение № 20

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

Ранг: Участник клуба

Сообщений: 3209

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

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

2003

Пересохраните свой файл в формате XLX (Excel-2003) и скидывайте.
Файлы XLX я открывать могу, просто злобная антивирь выдирает из них все процедуры. Но имена и структура данных остаются не тронутыми.
Но у меня только 1 час времени. Потом уеду на объект (хватит на работе сидеть

в пятницу). На следующей неделе я в отпуске, а дома макросы обычно не пишу.

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Процедура Worksheet_BeforeDoubleClick для нескольких ячеек (Макросы/Sub)

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

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