Добрый день! Подскажите, пожалуйста, можно ли выполнить процедуру 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]
Добрый день! Подскажите, пожалуйста, можно ли выполнить процедуру 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
Так как шаблон, при его добавлении между строками разделов (закрашены в файле зеленной заливкой), будет смещать эти строки и у них будет меняться адрес, то думаю нужно указывать имя ячейки.
Так как шаблон, при его добавлении между строками разделов (закрашены в файле зеленной заливкой), будет смещать эти строки и у них будет меняться адрес, то думаю нужно указывать имя ячейки.Лорик
Ввод фразы "С работы загружать файлы с макросами не могу (спасибо собакам-сисадминам)" мне, наверное, нужно в подпись добавить
Абсолютно верно сказал gling. Нужно просто внутри скобок после Intersect перечислить диапазоны или их имена через запятую. Только чтобв по даблклику по ячейкам этих диапазонов не входить в режим редактирования ячейки, нужно после Intersect добавить ещё одну команду: Cancel = True
Ввод фразы "С работы загружать файлы с макросами не могу (спасибо собакам-сисадминам)" мне, наверное, нужно в подпись добавить
Абсолютно верно сказал gling. Нужно просто внутри скобок после Intersect перечислить диапазоны или их имена через запятую. Только чтобв по даблклику по ячейкам этих диапазонов не входить в режим редактирования ячейки, нужно после Intersect добавить ещё одну команду: Cancel = TrueAlex_ST
Хотя... Поспешил. Диапазоны-аргументы нужно, наверное, сначала объединить, используя 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] , но ведь попробовать никто не мешает.
Хотя... Поспешил. Диапазоны-аргументы нужно, наверное, сначала объединить, используя 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] , но ведь попробовать никто не мешает.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Пятница, 03.10.2014, 08:37
сначала объединить, используя Union, а потом уже вставлять в Intersect. Не уверен, сработает ли Intersect (Union("XXXX", "YYYY", "ZZZ", Target) , но ведь попробовать никто не мешает.
Моя не понимать. Можете поправить мой код. Пожа-ааа-луйста!
сначала объединить, используя Union, а потом уже вставлять в Intersect. Не уверен, сработает ли Intersect (Union("XXXX", "YYYY", "ZZZ", Target) , но ведь попробовать никто не мешает.
Моя не понимать. Можете поправить мой код. Пожа-ааа-луйста!Лорик
Сообщение отредактировал Лорик - Пятница, 03.10.2014, 08:40
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? Имена моих ячеек?
Так нужно?
[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? Имена моих ячеек?Лорик
Ну, естественно Я же не могу открыть Ваш файл и посмотреть. Поэтому имена взял с потолка. Ну и свою процедуру уж приведите в один стиль написания. Не по фэншую мешать стили. Уж либо везде в квадраьных скобках [XXXX] , либо везде Range("XXXX")
Ну, естественно Я же не могу открыть Ваш файл и посмотреть. Поэтому имена взял с потолка. Ну и свою процедуру уж приведите в один стиль написания. Не по фэншую мешать стили. Уж либо везде в квадраьных скобках [XXXX] , либо везде Range("XXXX")Alex_ST
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
... но работает не так как я хотела. Вопрос был в следующем, чтобы при двойном клике на ячейку с наименованием первого раздела, добавлялись строки (шаблон строк) в ПЕРВЫЙ раздел, при двойном клике на ячейку второго раздела, добавлялся шаблон ВТОРОГО раздела, и аналогично третий раздел. В Вашем случае при двойном клике на ячейку любого из разделов добавляются шаблоны СРАЗУ во все разделы. (прим. ШАБЛОНЫ для разделов разные). Может не правильно все таки слепила код или данная процедура не будет работать при таких условиях?!
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
... но работает не так как я хотела. Вопрос был в следующем, чтобы при двойном клике на ячейку с наименованием первого раздела, добавлялись строки (шаблон строк) в ПЕРВЫЙ раздел, при двойном клике на ячейку второго раздела, добавлялся шаблон ВТОРОГО раздела, и аналогично третий раздел. В Вашем случае при двойном клике на ячейку любого из разделов добавляются шаблоны СРАЗУ во все разделы. (прим. ШАБЛОНЫ для разделов разные). Может не правильно все таки слепила код или данная процедура не будет работать при таких условиях?!Лорик
Чтобы обратиться к листу, на котором расположен именованный диапазон, нужно использовать свойство .Parent. Например, снять защиту с листа, на котором расположен диапазон "шаблон":[vba]
Код
[шаблон].Parent.Unprotect
[/vba]или просто перейти на лист:[vba]
Код
[шаблон].Parent.Select
[/vba] ------------------------------------- Без файла, похоже, не разобраться... Где, какой именованный диапазон расположен? У Вас что, лист, где расположен диапазон "шаблон" запаролен? Или это не имя диапазона, а имя запароленного листа? А на этом листе - именованные диапазоны "имя1", "имя2", имя3", в которых шаблоны для вставки в соответствующие разделы?
Чтобы обратиться к листу, на котором расположен именованный диапазон, нужно использовать свойство .Parent. Например, снять защиту с листа, на котором расположен диапазон "шаблон":[vba]
Код
[шаблон].Parent.Unprotect
[/vba]или просто перейти на лист:[vba]
Код
[шаблон].Parent.Select
[/vba] ------------------------------------- Без файла, похоже, не разобраться... Где, какой именованный диапазон расположен? У Вас что, лист, где расположен диапазон "шаблон" запаролен? Или это не имя диапазона, а имя запароленного листа? А на этом листе - именованные диапазоны "имя1", "имя2", имя3", в которых шаблоны для вставки в соответствующие разделы?Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Пятница, 03.10.2014, 10:30
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.
[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.RAN
Даблклик по любой ячейке строки, содержащей порядковые номера 1-3.
RAN, добавляются новые ПУСТЫЕ строки, но мне нужно чтобы добавлялись строки ШАБЛОНОВ. При нескольких видах Реагентов, ГСМ, Материалов, нужно добавлять дополнительные строки (наименование, расход, цена, затраты), в виде того шаблона, который указан в каждом разделе.
Даблклик по любой ячейке строки, содержащей порядковые номера 1-3.
RAN, добавляются новые ПУСТЫЕ строки, но мне нужно чтобы добавлялись строки ШАБЛОНОВ. При нескольких видах Реагентов, ГСМ, Материалов, нужно добавлять дополнительные строки (наименование, расход, цена, затраты), в виде того шаблона, который указан в каждом разделе.Лорик
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]
[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
Пересохраните свой файл в формате XLX (Excel-2003) и скидывайте. Файлы XLX я открывать могу, просто злобная антивирь выдирает из них все процедуры. Но имена и структура данных остаются не тронутыми. Но у меня только 1 час времени. Потом уеду на объект (хватит на работе сидеть в пятницу). На следующей неделе я в отпуске, а дома макросы обычно не пишу.
Пересохраните свой файл в формате XLX (Excel-2003) и скидывайте. Файлы XLX я открывать могу, просто злобная антивирь выдирает из них все процедуры. Но имена и структура данных остаются не тронутыми. Но у меня только 1 час времени. Потом уеду на объект (хватит на работе сидеть в пятницу). На следующей неделе я в отпуске, а дома макросы обычно не пишу.Alex_ST