Страницы: 1
RSS
Автоматически поставить пароль по наступлению даты
 
Уважаемые Гуру! Прошу помощи! Задача: необходим макрос который по истечении времени заблокирует книгу и выведет окошко примерно такого содержания "Для доступа к данным введите пароль". Код нашел на просторах интернета, только вот пишет синтаксическая ошибка. Прошу помочь! Спасибо!
Код
Private Sub Workbook_Open()
Dim i&, n&, P As Variant
Application.ScreenUpdating = False
n = 2
If Date = "05.05.2014" Then
For i = 1 To Sheets.Count
    Sheets(i).Activate
    Sheets(i).Protect "1234"
Next
End If
1:
P = InputBox("Время использования книги истекло, для продолжения введите пароль", "ВВОД ПАРОЛЯ")
If P = 1234 Then
For i = 1 To Sheets.Count
    Sheets(i).Activate
    Sheets(i).Unprotect "1234"
Next
Else
  If n = 0 Then
  Application.DisplayAlerts = False
  ThisWorkbook.Close
  Application.DisplayAlerts = True
  Else
  MsgBox "Пароль не верный, у вас еще " & n & " попытки"
  n = n - 1
  End If
  GoTo 1
End If
Application.ScreenUpdating = True
End Sub
 
Mike Belov, создал новую книгу, вставил код, сохранил - открыл...Всё работает
Microsoft Office 2010 64-bit, Windows 10 Professional 64-bit
 
Цитата
Artem1977 написал:
...Создал новую книгу, вставил код, сохранил - открыл...Всё работает
Подтверждаю!
Изменено: pitby - 07.12.2018 13:29:31
 
Спасибо, но не всё так гладко. Пароль требует всегда, не смотря на то что дата 01.03.2019 не наступила. Помогите пожалуйста!  Надо чтобы пароль требовало, только после наступления даты. Спасибо!

Код брал отсюда https://forum.msexcel.ru/index.php?topic=10179.0
Изменено: Mike Belov - 07.12.2018 14:23:08
 
Код
Private Sub Workbook_Open()

Dim i&, n&, P As Variant

Application.ScreenUpdating = False
   n = 2
If Date >= CDate("01.03.2019") Then
   For i = 1 To Sheets.Count
       Sheets(i).Activate
       Sheets(i).Protect "1234"
   Next
   
1:
   P = InputBox("Время использования книги истекло, для продолжения введите пароль", "ВВОД ПАРОЛЯ")

   If P = 1234 Then
      For i = 1 To Sheets.Count
          Sheets(i).Activate
          Sheets(i).Unprotect "1234"
      Next
   Else
      If n = 0 Then
         Application.DisplayAlerts = False
           ThisWorkbook.Close
         Application.DisplayAlerts = True
      Else
         MsgBox "Пароль не верный, у вас еще " & n & " попытки"
         n = n - 1
      End If
     GoTo 1
   End If

End If

Application.ScreenUpdating = True

End Sub
 
А если по-человечески, а не на хинди, то
Код
Private Sub Workbook_Open()
 
Dim i As integer
Dim sh As Worksheet
 
If Date >= CDate("01.03.2019") Then
    For i=2 to 0 step -1
        If  = InputBox("Время использования книги истекло, для продолжения введите пароль", "ВВОД ПАРОЛЯ") = 1234 Then Exit For
        MsgBox "Пароль не верный, у вас еще " & i & " попытки"
    Next i
    If i=3 Then
        For Each sh In Worksheets
              sh.Protect "1234"
        Next sh
        ThisWorkbook.Close
    End If
End If

End Sub
Изменено: StoTisteg - 10.12.2018 17:10:27 (оно собственно и так не мелькает)
 
StoTisteg, ошибка во втором
Код
Next i

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
А, ну да. Исправил.
 
Можно просто Next (без указания переменной-счётчика) - тогда бы и ошибки не возникло )
 
Юрий М, я в курсе, но не люблю так делать - читаемость кода страдает...
 
Табуляция помогает )
 
Особенно весело она помогает, если цикл в один экран не помещается... Раз уж можно пометить, что эта скобка закрывает, надо пользоваться :)
 
Цитата
StoTisteg написал:
Раз уж можно пометить
:D +++
Это - из жизни, не только VBA  :)  Собачки и кошечки так и делают, чтобы в дальнейшем не возникало ошибок и непоняток  :)  
Страницы: 1
Наверх