Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("A1")) Is Nothing Then Call script_1
End Sub

Range("B1").ClearContents
Range("C1").Value = 5

Sub Protection()
    Dim ws As Worksheet
    ActiveWorkbook.Protect Password:=123, Structure:=True
    For Each ws In Worksheets
        ws.Protect Password:=123, UserInterfaceOnly:=True: ws.EnableSelection = xlNoRestrictions
    Next
End Sub

Sub replace()
    fname = ThisWorkbook.Path + "\" + ThisWorkbook.Name
   
        ' как-то разорвать связь исходника с диском, чтоб иметь возможность записать поверх.
     
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=fname, FileFormat _
        :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWindow.Close
End Sub

Sub sendMail()
    Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/"
    Dim oCDOCnf As Object, oCDOMsg As Object
    Dim SMTPserver As String, sUsername As String, sPass As String, sMsg As String
    Dim sTo As String, sFrom As String, sSubject As String, sBody As String, sAttachment As String
    On Error Resume Next
    'sFrom – как правило совпадает с sUsername
    SMTPserver = "smtp-relay.gmail.com"    ' SMTPServer
    sUsername = "email_01@gmail.com"    ' Учетная запись на сервере
    sPass = "*****"    ' Пароль к почтовому аккаунту
 
    If Len(SMTPserver) = 0 Then MsgBox "Не указан SMTP сервер", vbInformation, "www.Excel-VBA.ru": Exit Sub
    If Len(sUsername) = 0 Then MsgBox "Не указана учетная запись", vbInformation, "www.Excel-VBA.ru": Exit Sub
    If Len(sPass) = 0 Then MsgBox "Не указан пароль", vbInformation, "www.Excel-VBA.ru": Exit Sub
 
    sTo = "email_02@gmail.com"    'Кому
    sFrom = "email_01@gmail.com"    'От кого
    sSubject = "Автоотправка"    'Тема письма
    sBody = "Проверка отправки"    'Текст письма
    sAttachment = "C:/Temp/Книга1.xls"    'Вложение(полный путь к файлу)
 
    'Назначаем конфигурацию CDO
    Set oCDOCnf = CreateObject("CDO.Configuration")
    With oCDOCnf.Fields
        .Item(CDO_Cnf & "sendusing") = 2
        .Item(CDO_Cnf & "smtpauthenticate") = 1
        .Item(CDO_Cnf & "smtpserver") = SMTPserver
        'если необходимо указать SSL
        .Item(CDO_Cnf & "smtpserverport") = 465 'для Gmail 465
        .Item(CDO_Cnf & "smtpusessl") = True
        '=====================================
        .Item(CDO_Cnf & "sendusername") = sUsername
        .Item(CDO_Cnf & "sendpassword") = sPass
        .Update
    End With
    'Создаем сообщение
    Set oCDOMsg = CreateObject("CDO.Message")
    With oCDOMsg
        Set .Configuration = oCDOCnf
        .BodyPart.Charset = "koi8-r"
        .From = sFrom
        .To = sTo
        .Subject = sSubject
        .TextBody = sBody
        'Проверка наличия файла по указанному пути
        If Len(sAttachment) > 0 Then
            If Dir(sAttachment, 16) <> "" Then
                .AddAttachment sAttachment
            End If
        End If
        .Send
    End With
 
    Select Case Err.Number
    Case -2147220973: sMsg = "Нет доступа к Интернет"
    Case -2147220975: sMsg = "Отказ сервера SMTP"
    Case 0: sMsg = "Письмо отправлено"
    Case Else: sMsg = "Ошибка номер: " & Err.Number & vbNewLine & "Описание ошибки: " & Err.Description
    End Select
    MsgBox sMsg, vbInformation, "www.Excel-VBA.ru"
    Set oCDOMsg = Nothing: Set oCDOCnf = Nothing
End Sub

Sub checkAccess()
    
    ThisWorkbook.RemovePersonalInformation = 0
    
    Dim XMLHTTP As Object
    Dim URL$
    
    URL = "https://somelink"
    
    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
    XMLHTTP.Open "GET", URL, False
    On Error Resume Next
    XMLHTTP.send
        If XMLHTTP.Status = 200 Then
            MsgBox "Ссылка доступна."
        Else
            MsgBox XMLHTTP.Status & " - Ссылка НЕ доступна."
            SetAttr ThisWorkbook.Path + "\" + ThisWorkbook.Name, vbReadOnly = False
            Cells(1, 1) = Time
            
            ThisWorkbook.Save ' Почему не сохраняет?
        End If
    Set XMLHTTP = Nothing
End Sub

function add_1() {
  var ss = SpreadsheetApp.getActive();

    ss.getActiveSheet().insertRowsBefore(9, 1);

    ss.getRange('A9').setValue(new Date());
    ss.getRange('B9').setValue(ss.getRange('B3').getValue())
    ss.getRange('C9').setValue(ss.getRange('C3').getValue())
    ss.getRange('D9').setValue(ss.getRange('D3').getValue())
    ss.getRange('E9').setValue(ss.getRange('E3').getValue())
    
    ss.getRange('D3').clearContent();

    summary()

};

Range("A1:F20").CopyPicture

Private Sub Workbook_Open()
    Application.DisplayAlerts = False ' не подавляет системное сообщение с предложением открыть для чтения.
     If Environ("USERNAME") <> "admin" Then
        MsgBox "Файл открыт для чтения," & Chr(10) & "ИЗМЕНЕНИЯ НЕ СОХРАНЯТСЯ!"
        If Not ThisWorkbook.ReadOnly Then ThisWorkbook.ChangeFileAccess xlReadOnly
     End If
     Application.DisplayAlerts = True
End Sub

Private Sub Workbook_Open()
     If  Environ("USERNAME") <> "admin" Then (открыть только для чтения)
End Sub

Sub main()
    Call aaa
    Call bbb
End Sub

Sub aaa()
    ReDim arr(1 To 3, 1 To 3)
End Sub

Sub bbb()
    x = arr(1, 1)
End Sub

Private Sub Workbook_Open()
    Call protection
End Sub

Public Const pass As Long = 123

Sub protection()
    Dim ws As Worksheet
    ActiveWorkbook.Protect Password:=pass, structure:=True
    For Each ws In Worksheets
        ws.Protect Password:=pass, UserInterfaceOnly:=True: ws.EnableSelection = xlNoRestrictions
    Next
End Sub