Sub CreateEventProcedure()
      Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
      Dim lLineNum As Long
      On Error Resume Next
Set objVBProj = ActiveWorkbook.VBProject
Set objVBComp = objVBProj.VBComponents(ActiveWorkbook.CodeName)
Set objCodeMod = objVBComp.CodeModule
      'вставляем код
      With objCodeMod
            lLineNum = .CreateEventProc("BeforeClose", "Workbook")
            lLineNum = lLineNum + 1
            .InsertLines lLineNum, "Application.AskToUpdateLinks = False"
      End With
End Sub

Dim xTime As String
Dim xWB As Workbook
 
Private Sub Workbook_Open()
'Updated by Extendoffice 2019/1/20
    On Error Resume Next
    xTime = Application.InputBox("Please specify the idle time:", "KuTool For Excel", "00:00:20", , , , , 2)
    Set xWB = ActiveWorkbook
    If xTime = "" Then Exit Sub
    Reset
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    On Error Resume Next
    If xTime = "" Then Exit Sub
    Reset
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If xTime = "" Then Exit Sub
    Reset
End Sub
 
Sub Reset()
    Static xCloseTime
    If xCloseTime <> 0 Then
        ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , False
    End If
    xCloseTime = Now + TimeValue(xTime)
    ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , True
End Sub

Private Sub UserForm_Initialize()
' positioning http://www.vbaexpress.com/kb/getarticle.php?kb_id=382#instr
    Me.StartUpPosition = 0
    Me.Top = Application.Top + Application.Height - Me.Height - 45
    Me.Left = Application.Left + Application.Width - Me.Width - 45

    Dim p As String, f As String: Application.ScreenUpdating = False
      p = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\": f = "ALL.xlsb"
    If Dir(p & f) = "" Then
        MsgBox "== File is missing ==": Exit Sub
    End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Extr p, f, "all", "A1:E30000"
    With ThisWorkbook.Sheets(1)
        .Columns(2).Replace 0, Empty, xlWhole
        z = .Range("A2:E" & .Cells(Rows.Count, 2).End(xlUp).Row).Value
        .[A:E].ClearContents
    End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
tmp
End Sub

Sub NamesDropsX()

' clear all Names Удаление ВСЕХ именованных диапозонов
For Each IName In ActiveWorkbook.Names
      IName.Delete ' delete ALL named areas !!!
Next

' set Print Area Устанока Области Печати
    ActiveSheet.PageSetup.PrintArea = "$A$2:$AD$55"

' add "agents" and "pay" - заполнение диапозонов данными
     Sheets("izsniedzeji").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "RK"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "VM"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "JP"
    
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Parskait" ' unicode
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "Skaidra nauda" ' unicode
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "Karte" ' unicode
    
' set Names - pay | agent - Назначение именованных диапозонов
Sheets("izsniedzeji").Select
    Range("A1:A3").Select
    ActiveWorkbook.Names.Add Name:="agent", RefersToR1C1:="=izsniedzeji!R1C1:R3C1"
    Range("B1:B3").Select
    ActiveWorkbook.Names.Add Name:="pay", RefersToR1C1:="=izsniedzeji!R1C2:R3C2"

' clear All Drops - удаление всех выпадающих списков
Sheets("PPR").Select
    ActiveCell.SpecialCells(xlCellTypeAllValidation).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Range("A18").Select

' set Drop - pay and agent = methode nr.2 - назначение ячеек с выпадающими списками
Sheets("PPR").Select
    Range("J17:O17").Select ' pay name
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=pay"
        .IgnoreBlank = False
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "ERROR"
        .InputMessage = ""
        .ErrorMessage = "ERROR!!!"
        .ShowInput = False
        .ShowError = True
    End With

        Range("G46:P46").Select ' agent name
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=agent"
        .IgnoreBlank = False
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "ERROR"
        .InputMessage = ""
        .ErrorMessage = "ERROR!!!"
        .ShowInput = False
        .ShowError = True
    End With
    Range("A1").Select

End Sub