Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Снятие пароля с блокируемых строк по условию.
 
#1
07.12.2021 10:23:06
Просьба помочь .Пробую сама написать. Макрос по кнопке, необходимо блокировать строки(нельзя внести изменения), где "дата акта" за предыдущие месяцы. То есть текущий декабрь, все что до (например 30 ноября) заблокируется и надо еще чтобы пользователи могли по паролю снимать блокировку и вносить изменения даты, как это сделать правильно, помогите плиз. Мой вариант не рабочий, может подскажите, что изменить.
Код
Sub Макрос1()
Dim d As Date
Dim a As Variant
Dim i As Integer
d = Format(Now, "DD.MM.YYYY")
a = Range("C1:C12")
On Error Resume Next
For i = 2 To 10
     If DateDiff("d", Sheets("Лист1").Range("C" & i).Value, Date) > 30 Then
        ActiveSheet.Unprotect
            Sheets("Лист1").Range("d" & i).Locked = True
            Sheets("Лист1").Range("e" & i).Locked = True
            Sheets("Лист1").Range("f" & i).Locked = True
            MsgBox "Нельзя менять прошлые периоды"
        Else
            Sheets("Лист1").Range("d" & i).Locked = False
            Sheets("Лист1").Range("e" & i).Locked = False
            Sheets("Лист1").Range("f" & i).Locked = False
        End If
        i = i + 1
        Next
        ActiveSheet.Protect
    
End Sub
 
 
 
#2
07.12.2021 10:28:17
, пароль какой?
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
07.12.2021 10:36:54
123
 
 
 
#4
07.12.2021 10:46:16
в модуль листа
Код
Private Sub CommandButton1_Click()
    Call Макрос1
End Sub
Sub Макрос1()
Dim d As Date
Dim a As Variant
Dim i As Integer, lr As Long
d = Format(Now, "DD.MM.YYYY")
lr = Cells(Rows.Count, 1).End(xlUp).Row
a = Range("C1:C" & lr)
On Error Resume Next
For i = 2 To lr
x = DateDiff("D", Sheets("Лист1").Range("C" & i).Value, Date)
     If x > 30 Then
        ActiveSheet.Unprotect Password:="123"
            Sheets("Лист1").Range("A" & i & ":F" & i).Locked = True
            Cells(i, 8) = "Protect"
        Else
            Sheets("Лист1").Range("A" & i & ":F" & i).Locked = False
            Cells(i, 8) = "UNProtect"
        End If
        Next
        ActiveSheet.Protect Password:="123"
        MsgBox "Нельзя менять прошлые периоды"
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Target.Column >= 1 And Target.Column <= 6 Then
        Range(Cells(Target.Row, 1), Cells(Target.Row, 6)).Select
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True
        ActiveSheet.EnableSelection = xlNoRestrictions
    
    End If
End Sub

Sub Макрос3()
    Range("A5:F5").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True
    ActiveSheet.EnableSelection = xlNoRestrictions
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
07.12.2021 11:56:43
Спасибо, посмотрела, вопрос: а как убрать блокировку всего листа при открытии таблицы, чтобы можно было сразу ее заполнять, но при этом строки за предыдущий период должны быть закрыты. их можно было разблокировать по кнопке с паролем. Ни как не пойму как это сделать(
 
 
 
Страницы: 1
Наверх