Здравствуйте. Имеется табель по питанию. Ежедневно проставляются отсутствующие (ставится "н" в ячейку). Как запретить редактирование/удаление содержимого ячейки задним числом ? Допустим, ставим сегодня (11.11.21) "н" Василию Пупкину (он сегодня не питался), Валерию Олеговичу мы оставляем в этот же день пустую ячейку (он питался). Завтра (12.11.21) нужно запретить редактировать ячейки за прошедшие даты. Знаю, что это решается макросом, но, я к сожалению в этом не силен.
Здравствуйте. Имеется табель по питанию. Ежедневно проставляются отсутствующие (ставится "н" в ячейку). Как запретить редактирование/удаление содержимого ячейки задним числом ? Допустим, ставим сегодня (11.11.21) "н" Василию Пупкину (он сегодня не питался), Валерию Олеговичу мы оставляем в этот же день пустую ячейку (он питался). Завтра (12.11.21) нужно запретить редактировать ячейки за прошедшие даты. Знаю, что это решается макросом, но, я к сожалению в этом не силен.scryde2015
1) снимаем флаг защиты ячейки 2) в модуль книги [vba]
Код
Private Sub Workbook_SheetActivate(ByVal Sh As Object) Call u_745 End Sub Private Sub Workbook_Open() Call u_745 End Sub Sub u_745() Application.ScreenUpdating = False a = ActiveSheet.Name If a <> "календарь" Then Dim b As Double b = Date c = Evaluate("=MAX(IF((F9:AJ9<" & b & ")*(F9:AJ9<>""""),COLUMN(F9:AJ9)))") If c <> 0 Then ActiveSheet.Unprotect Password:="123" Range(Cells(12, 6), Cells(38, c)).Locked = True ActiveSheet.Protect Password:="123" End If End If Application.ScreenUpdating = True End Sub
[/vba]123 - пароль защиты листа
1) снимаем флаг защиты ячейки 2) в модуль книги [vba]
Код
Private Sub Workbook_SheetActivate(ByVal Sh As Object) Call u_745 End Sub Private Sub Workbook_Open() Call u_745 End Sub Sub u_745() Application.ScreenUpdating = False a = ActiveSheet.Name If a <> "календарь" Then Dim b As Double b = Date c = Evaluate("=MAX(IF((F9:AJ9<" & b & ")*(F9:AJ9<>""""),COLUMN(F9:AJ9)))") If c <> 0 Then ActiveSheet.Unprotect Password:="123" Range(Cells(12, 6), Cells(38, c)).Locked = True ActiveSheet.Protect Password:="123" End If End If Application.ScreenUpdating = True End Sub
Спасибо большое. Можно ли сделать как-то привязку к месяцу ? Сейчас, например, добавил в табель октябрь, переключился на октябрь месяц, а редактировать могу так же, как и в ноябре, с 11 числа по 31. Можно это как-то обойти ? Чтобы предыдущие месяцы тоже нельзя было изменять ?
Спасибо большое. Можно ли сделать как-то привязку к месяцу ? Сейчас, например, добавил в табель октябрь, переключился на октябрь месяц, а редактировать могу так же, как и в ноябре, с 11 числа по 31. Можно это как-то обойти ? Чтобы предыдущие месяцы тоже нельзя было изменять ?scryde2015
Чтобы предыдущие месяцы тоже нельзя было изменять ?
Поставьте листы с предыдущими месяцами под пароль и никому его не говорите Как только месяц кончился - лист под пароль от редактирования и стереть код VBA в модуле листа:) В модуль листа: [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i, rn As Range, lc&, lr&, d& Set rn = ActiveSheet.Range("F12:AJ38") Set i = Application.Intersect(rn, Target) lc = Target.Column lr = Target.Row d = Day(Now) If i Is Nothing Then Exit Sub Else If lc <> d Then Cells(lr, d + 5).Select End If End If End Sub
[/vba] Курсор вернется на ячейку с сегодняшним днем Только обратите внимание на Set rn = ActiveSheet.Range("F12:AJ38" - строки и столбцы) Обнаружилась загадка в файле ТС-а: столбец "K" не реагирует на событие листа, с остальными вроде нормально. Win7 Of2007. Это только у меня так?
Чтобы предыдущие месяцы тоже нельзя было изменять ?
Поставьте листы с предыдущими месяцами под пароль и никому его не говорите Как только месяц кончился - лист под пароль от редактирования и стереть код VBA в модуле листа:) В модуль листа: [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i, rn As Range, lc&, lr&, d& Set rn = ActiveSheet.Range("F12:AJ38") Set i = Application.Intersect(rn, Target) lc = Target.Column lr = Target.Row d = Day(Now) If i Is Nothing Then Exit Sub Else If lc <> d Then Cells(lr, d + 5).Select End If End If End Sub
[/vba] Курсор вернется на ячейку с сегодняшним днем Только обратите внимание на Set rn = ActiveSheet.Range("F12:AJ38" - строки и столбцы) Обнаружилась загадка в файле ТС-а: столбец "K" не реагирует на событие листа, с остальными вроде нормально. Win7 Of2007. Это только у меня так?_Igor_61
Сообщение отредактировал _Igor_61 - Четверг, 11.11.2021, 17:45
Private Sub Worksheet_Change(ByVal Target As Range) Dim LastRow As Long Dim DataP As Long Dim DataP1 As Long Dim DataP2 As Long LastRow = Cells(Rows.Count, 2).End(xlUp).Row On Error Resume Next DataP = WorksheetFunction.Match(CLng(Date), Rows(9), 0) - 1 DataP1 = Format(Range("F9").Value, "mm") DataP2 = Format(CLng(Date), "mm") If DataP1 < DataP2 Then If Not Intersect(Target, Range(Cells(12, 6), Cells(LastRow, 36))) Is Nothing Then MsgBox "Запрещено изменять данные ячеек вчерашним днём!!!!!" Application.EnableEvents = 0 Application.Undo Application.EnableEvents = 1 End If End If If DataP1 = DataP2 Then If Not Intersect(Target, Range(Cells(12, 6), Cells(LastRow, DataP))) Is Nothing Then MsgBox "Запрещено изменять данные ячеек вчерашним днём!!!!!" Application.EnableEvents = 0 Application.Undo Application.EnableEvents = 1 End If End If Application.EnableEvents = 1 End Sub
[/vba]
В модуль листа и меняйте месяца как хотите
[vba]
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) Dim LastRow As Long Dim DataP As Long Dim DataP1 As Long Dim DataP2 As Long LastRow = Cells(Rows.Count, 2).End(xlUp).Row On Error Resume Next DataP = WorksheetFunction.Match(CLng(Date), Rows(9), 0) - 1 DataP1 = Format(Range("F9").Value, "mm") DataP2 = Format(CLng(Date), "mm") If DataP1 < DataP2 Then If Not Intersect(Target, Range(Cells(12, 6), Cells(LastRow, 36))) Is Nothing Then MsgBox "Запрещено изменять данные ячеек вчерашним днём!!!!!" Application.EnableEvents = 0 Application.Undo Application.EnableEvents = 1 End If End If If DataP1 = DataP2 Then If Not Intersect(Target, Range(Cells(12, 6), Cells(LastRow, DataP))) Is Nothing Then MsgBox "Запрещено изменять данные ячеек вчерашним днём!!!!!" Application.EnableEvents = 0 Application.Undo Application.EnableEvents = 1 End If End If Application.EnableEvents = 1 End Sub
scryde2015, все работает. просто активируйте лист - перейдите на календарь, вернитесь на октябрь, или закройте файл и откройте заново и создавайте столько листов, сколько нужно
scryde2015, все работает. просто активируйте лист - перейдите на календарь, вернитесь на октябрь, или закройте файл и откройте заново и создавайте столько листов, сколько нужноNic70y
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
Как только месяц кончился - лист под пароль от редактирования и стереть код VBA в модуле листа:)
