Сохранение листа книги в файле - проблема с защитой листа и привязкой макросов - VBA - Ответ 4090698

Sub Unprotect_VBA()
    Dim objVBProject As Object, objVBComponent As Object, objWindow As Object
 
    Workbooks.Open "C:\1.xls"
    Set objVBProject = ActiveWorkbook.VBProject
    'просматриваем все окна проекта в поисках окна снятия защиты
    For Each objWindow In objVBProject.VBE.Windows
        ' Type = 6 - это нужное нам окно
        If objWindow.Type = 6 Then
            objWindow.Visible = True
            objWindow.SetFocus: Exit For
        End If
    Next
    'вводим пароль и подтверждаем ввод
    SendKeys "~1234~", True: SendKeys "{ENTER}", True
    'здесь Ваш код по внесению изменений в проект
    Set objVBProject = Nothing: Set objVBComponent = Nothing: Set objWindow = Nothing
    ActiveWorkbook.Close True
End Sub

Set objVBProject = ActiveWorkbook.VBProject
    'просматриваем все окна проекта в поисках окна снятия защиты
    For Each objWindow In objVBProject.VBE.Windows
        ' Type = 6 - это нужное нам окно
        If objWindow.Type = 6 Then
            objWindow.Visible = True
            objWindow.SetFocus: Exit For
        End If
    Next
    'вводим пароль и подтверждаем ввод
    SendKeys "~~", True: SendKeys "{ENTER}", True    
      If ActiveWorkbook.VBProject.Protection = 1 Then
        MsgBox "VBProject выбранной книги защищён." & vbCrLf & _
             "     Компоненты не будут удалены.", vbExclamation, "Отмена выполнения"
            End If
For Each oVBComponent In ActiveWorkbook.VBProject.VBComponents
        On Error Resume Next
        With oVBComponent
            Select Case .Type
            Case 1    'Модули
 
 
                .Collection.Remove oVBComponent
            Case 2    'Модули Класса
                .Collection.Remove oVBComponent
            Case 3    'Формы
                .Collection.Remove oVBComponent
            Case 100    'ЭтаКнига, Листы
                    lCountLines = .CodeModule.CountOfLines
                    .CodeModule.DeleteLines 1, lCountLines
            End Select
        End With
Next
    Set oVBComponent = Nothing