Developing.ru

Код: Выделить всё

Sub NoStart()
Dim iName
 iName = "ИмяКниги"
iFullName = "C:\Temp\" & iName'обе книги в одной папке
With Application
     .EnableEvents = False
     .Workbooks.Open Filename:=iFullName
     .EnableEvents = True
End With
End Sub

Код: Выделить всё

Sub SheetsPassw() ' листы по выбору, если листы скрытые - выскочит ошибка
    iPass = InputBox("Введите новый пароль") 'пароль можно ввести так
    'достаточно интересный вариант, пароль не хранится в открытом виде
'    iPass = "321"' или сразу в коде
For Each iList In Worksheets(Array("Лист1", "Лист2", "Лист3"))
    Worksheets(iList.Index).Protect Password:=iPass, UserInterfaceOnly:=True
'    раскомментируйте MsgBox и увидите работу макроса
'    MsgBox "Имя рабочего листа : " & iList.Name & ", пароль:  " & iPass
    Next
End Sub
Sub AllSheetsPassw() 'все рабочие листы книги, в том числе и скрытые
     Application.ScreenUpdating = False
     Dim iWorksheet As Worksheet, iHidden As Boolean
     For Each iWorksheet In ThisWorkbook.Worksheets
         If iWorksheet.Visible <> True Then 'если есть скрытые листы, перед установкой пароля - отобразить
            iHidden = True
            iOldVisible& = iWorksheet.Visible
            iWorksheet.Visible = True
         End If
         iWorksheet.Protect Password:="12345", UserInterfaceOnly:=True
         If iHidden = True Then ' и опять все скрыть
            iWorksheet.Visible = iOldVisible&
            iHidden = False
         End If
     Next
     Application.ScreenUpdating = False
End Sub
Sub EnterPass() ' можно проверить пароль на правильность
        iPass = "321" 'но только если Вы его знаете :-)
        Pword = InputBox("Введите пароль")
    If Pword <> iPass Then
        MsgBox "Неправильный пароль"
        End
    End If
End Sub