Здравствуйте. Пользуюсь макросом (спасибо Алексею Матевосову) который записан в "эта книга". Работа макроса нужна на большинстве листах, но не на всех. Макрос изменяет содержимое ячеек на листах, где его работа не нужна. Пробовал убирать макрос из книги и помещать в соответствующие листы, но он тогда вообще переставал работать. Как сделать, чтобы макрос работал только на нужных листах? Спасибо.
Макрос такой: [vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'водим дату открытия и закрытия сессии If Not Intersect(Range("J5:U" & Range("C4").End(xlDown).Row), Target) Is Nothing Then Range("F" & Target.Row) = IIf(Range("E" & Target.Row) = "Д", Date, "") End If
If Not Intersect(Range("G5:I" & Range("C4").End(xlDown).Row), Target) Is Nothing Then Range("W" & Target.Row) = IIf(Range("V" & Target.Row) = "Сд", Date, "") End If
'создаем примечание с датой сдачи экзамена If Intersect(Target, Range("AG:AG")) Is Nothing Then Exit Sub
Dim oComment As Comment On Error Resume Next Set oComment = Target.Comment If oComment Is Nothing Then Target.AddComment Target.Text & " " & Range("AI" & Target.Row)
Else oComment.Text oComment.Text & Chr(10) & Target.Text & " " & Range("AI" & Target.Row) End If End Sub
[/vba]
Здравствуйте. Пользуюсь макросом (спасибо Алексею Матевосову) который записан в "эта книга". Работа макроса нужна на большинстве листах, но не на всех. Макрос изменяет содержимое ячеек на листах, где его работа не нужна. Пробовал убирать макрос из книги и помещать в соответствующие листы, но он тогда вообще переставал работать. Как сделать, чтобы макрос работал только на нужных листах? Спасибо.
Макрос такой: [vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'водим дату открытия и закрытия сессии If Not Intersect(Range("J5:U" & Range("C4").End(xlDown).Row), Target) Is Nothing Then Range("F" & Target.Row) = IIf(Range("E" & Target.Row) = "Д", Date, "") End If
If Not Intersect(Range("G5:I" & Range("C4").End(xlDown).Row), Target) Is Nothing Then Range("W" & Target.Row) = IIf(Range("V" & Target.Row) = "Сд", Date, "") End If
'создаем примечание с датой сдачи экзамена If Intersect(Target, Range("AG:AG")) Is Nothing Then Exit Sub
Dim oComment As Comment On Error Resume Next Set oComment = Target.Comment If oComment Is Nothing Then Target.AddComment Target.Text & " " & Range("AI" & Target.Row)
Else oComment.Text oComment.Text & Chr(10) & Target.Text & " " & Range("AI" & Target.Row) End If End Sub
Просто в начале макроса надо проверять ещё и (не)соответствие нужному вам листу. Т.е. либо где-то прописать список тех листов, на которые макрос (не)должен реагировать (в виде списка на листе, именованного диапазона или формулы, прямо здесь в макросе, наконец), либо по каким-то признакам уметь определять "нужные" листы (на основе имеюшейся на них структуры информации, например). В любом случае, надо на ваш файл смотреть...
Просто в начале макроса надо проверять ещё и (не)соответствие нужному вам листу. Т.е. либо где-то прописать список тех листов, на которые макрос (не)должен реагировать (в виде списка на листе, именованного диапазона или формулы, прямо здесь в макросе, наконец), либо по каким-то признакам уметь определять "нужные" листы (на основе имеюшейся на них структуры информации, например). В любом случае, надо на ваш файл смотреть...AndreTM
Ребят, подскажите пожалуйста, каким образом можно прописать в моём случае листы, чтобы дважды не повторять одно и то же для листа SMT и для листа Maket
[vba]
Код
Private Sub SheetProtect() With Sheets("SMT") .Unprotect Password:="1234" .EnableOutlining = True .Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=False, _ AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _ AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _ AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowFiltering:=True, AllowSorting:=True, _ AllowUsingPivotTables:=True, UserInterfaceOnly:=True End With With Sheets("Maket") .Unprotect Password:="1234" .EnableOutlining = True .Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=False, _ AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _ AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _ AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowFiltering:=True, AllowSorting:=True, _ AllowUsingPivotTables:=True, UserInterfaceOnly:=True End With End Sub
[/vba]
Ребят, подскажите пожалуйста, каким образом можно прописать в моём случае листы, чтобы дважды не повторять одно и то же для листа SMT и для листа Maket
[vba]
Код
Private Sub SheetProtect() With Sheets("SMT") .Unprotect Password:="1234" .EnableOutlining = True .Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=False, _ AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _ AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _ AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowFiltering:=True, AllowSorting:=True, _ AllowUsingPivotTables:=True, UserInterfaceOnly:=True End With With Sheets("Maket") .Unprotect Password:="1234" .EnableOutlining = True .Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=False, _ AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _ AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _ AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowFiltering:=True, AllowSorting:=True, _ AllowUsingPivotTables:=True, UserInterfaceOnly:=True End With End Sub
Private Sub SheetProtect() For Each wshts In ThisWorkbook.Worksheets If wshts.Name = "1C" Or wshts.Name = "Maket" Then With wshts .Unprotect Password:="1234" .EnableOutlining = True .Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=False, _ AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _ AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _ AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowFiltering:=True, AllowSorting:=True, _ AllowUsingPivotTables:=True, UserInterfaceOnly:=True End With End If Next wshts End Sub
[/vba]
Вопрос закрыт
[vba]
Код
Private Sub SheetProtect() For Each wshts In ThisWorkbook.Worksheets If wshts.Name = "1C" Or wshts.Name = "Maket" Then With wshts .Unprotect Password:="1234" .EnableOutlining = True .Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=False, _ AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, _ AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _ AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowFiltering:=True, AllowSorting:=True, _ AllowUsingPivotTables:=True, UserInterfaceOnly:=True End With End If Next wshts End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
