Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ЭтаКнига"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit

Private Const SAVE_STATUS_CRITICAL_IMPACT_WARNING As String = "Шаблон будет сохранен, но НЕ БУДЕТ принят к рассмотрению из-за невыполнения ОБЯЗАТЕЛЬНЫХ условий! См. лист 'Проверка'!"
Private Const SAVE_STATUS_SUCCESS As String = "Шаблон готов к сохранению без замечаний"
Private Const SAVE_STATUS_LOW_IMPACT_WARNING As String = "Шаблон будет принят к рассмотрению, но обратите внимание НЕВЫПОЛНЕНИЕ ПРЕДУПРЕДИТЕЛЬНЫХ условий на листе 'Проверка'"
Private Const SAVE_MESSAGE_TITLE As String = "Результат проверки"

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Application.Calculate
    
    Dim wsActiveSheet As Worksheet
    
    Set wb = Application.ThisWorkbook
    Set wsActiveSheet = wb.ActiveSheet
    
    If Len(CStr(Me.Names("region_name").RefersToRange.Value)) > 0 Then
        modPROV.WarningsBeforeSaving Me
              
        If modPROV.gintCriticalImpactWarningsCounter > 0 Then
          Me.CustomDocumentProperties("Status") = 1 'ТРАНС
          MsgBox SAVE_STATUS_CRITICAL_IMPACT_WARNING, vbCritical + vbOKOnly, SAVE_MESSAGE_TITLE
          Me.Worksheets("Проверка").Activate
        ElseIf modPROV.gintLowImpactWarningsCounter > 0 Then
          Me.CustomDocumentProperties("Status") = 1 'ТРАНС
          MsgBox SAVE_STATUS_LOW_IMPACT_WARNING, vbExclamation + vbOKOnly, SAVE_MESSAGE_TITLE
          Me.Worksheets("Проверка").Activate
        Else 'ТРАНС
          Me.CustomDocumentProperties("Status") = 2 'ТРАНС
          MsgBox SAVE_STATUS_SUCCESS, vbInformation, SAVE_MESSAGE_TITLE
          wsActiveSheet.Activate
        End If
        
    End If
    
    On Error GoTo ErrHandler
    
    Dim status As Integer
    status = wb.CustomDocumentProperties("Status")
    If status > 2 Then
      MsgBox "Документ подписан ЭЦП и не может быть изменен", vbExclamation + vbOKOnly, ThisWorkbook.name
      Cancel = True
      Exit Sub
    End If

    

    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbOKOnly + vbExclamation, ThisWorkbook.name
    
End Sub

Private Sub Workbook_Open()
  
  Application.Calculation = xlCalculationAutomatic ' чтобы пересчет формул осуществлялся автоматически
  Application.ReferenceStyle = xlA1 ' стиль ссылок - A1
  ThisWorkbook.CustomDocumentProperties("Status") = 1 'ТРАНС
  
  Dim wsSheet As Worksheet
  
  If Len(CStr(Me.Names("region_name").RefersToRange.cells(1, 1).Value)) = 0 Then
    For Each wsSheet In Me.Worksheets
      If wsSheet.Visible = True Then
        If wsSheet.Tab.ColorIndex = colorPaleBlue Then
          wsSheet.Visible = xlSheetVeryHidden
        End If
      End If
    Next wsSheet
  End If

End Sub

Attribute VB_Name = "modChange"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Base 1
Option Explicit

' Инструкция
Public Sub WsInstrChange(Target As Range)
  If Target.Interior.ColorIndex = colorYellow Then
    Application.ThisWorkbook.Sheets(gstrInstructionSheetName).cmdApplyContactChanges.Enabled = True
    Application.ThisWorkbook.Sheets(gstrInstructionSheetName).cmdApplyContactChanges.Visible = True
  End If
End Sub

' Титульный
Public Sub WsTitChange(Target As Range)
  On Error GoTo ErrWsTitChange
  
  Dim wbBook As Workbook
  
  Dim wsTechSheet As Worksheet
  Dim wsSheet As Worksheet
  Dim wsTempSheet As Worksheet
  Dim wsHypSheet As Worksheet
  Dim wsCommentsSheet As Worksheet
    
  Dim intCounter As Integer
  Dim intVisibleSheetArray As Integer     ' отображать /-1/ или нет /2/ листы /заданные списком/
  Dim intVisibleSheetHyp As Integer       ' отображать /-1/ или нет /2/ лист Ссылки на публикации
  Dim intNumStartRowForCheck As Integer
  Dim intNumEndRowForCheck As Integer
  
  Dim strMOName As String
  Dim strMRName As String
  Dim strOKTMOValue As String
  Dim strNameSheetArray(2) As String
    
  Dim rngRange As Range
  Dim rngRangeOne As Range
  Dim rngRangeTemp As Range
  Dim ISect

  blnValueEnableEvents = Application.EnableEvents
  blnValueScreenUpdating = Application.ScreenUpdating
  
  Application.EnableEvents = False
  Application.ScreenUpdating = False

  Set wbBook = Me.parent
  Set rngRange = wbBook.Names("MR_LIST").RefersToRange
  Set wsTechSheet = rngRange.parent

  Set wsSheet = Target.parent
  Set wsHypSheet = wbBook.Sheets(gstrHyperlinkSheetName)
  Set wsCommentsSheet = wbBook.Sheets(gstrCommentsSheetName)
  
  ' Какой сайт
  Set ISect = Application.Intersect(Target, wsSheet.Range("strPublication"))
  If Not ISect Is Nothing Then

    strNameSheetArray(1) = "ТС доступ"
    strNameSheetArray(2) = "Ссылки на публикации"

    
    Set wsTempSheet = wbBook.Sheets(strNameSheetArray(2))
    wsTempSheet.Activate
    modServiceModule.UNPROTECT_SHEET wsTempSheet
    
    ' остальные листы
    If InStr(LCase(Target.cells(1, 1).Value), "на сайте регулирующего органа") Then
      intVisibleSheetArray = -1
      intVisibleSheetHyp = -1
      wsTempSheet.Range("checkBC_2").Rows(1).EntireRow.Hidden = True
      wsTempSheet.Range("checkBC_2").Rows(1).Interior.ColorIndex = colorWhite
      wsTempSheet.Range("checkBC_2").Rows(1).Locked = True
      wsTempSheet.cells(wsTempSheet.Range("checkBC_2").cells(2, 1).Row, _
                        wsTempSheet.Range("Consecutive_number").cells(1, 1).Column).Value = "1.1"
      If InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionOne) Then
        wsTempSheet.cells(wsTempSheet.Range("checkBC_2").cells(2, 1).Row, _
                          wsTempSheet.Range("Consecutive_number").cells(1, 1).Column).Offset(1, 0).Value = "1.2"
      End If
    ElseIf InStr(LCase(Target.cells(1, 1).Value), "на официальном сайте организации") Then
      intVisibleSheetArray = 2
      intVisibleSheetHyp = -1
      wsTempSheet.Range("checkBC_2").Rows(1).EntireRow.Hidden = False
      wsTempSheet.Range("checkBC_2").cells(1, 1).Interior.ColorIndex = colorCyan
      wsTempSheet.Range("checkBC_2").cells(1, 5).Interior.ColorIndex = colorCyan
      wsTempSheet.Range("checkBC_2").cells(1, 1).Locked = False
      wsTempSheet.Range("checkBC_2").cells(1, 5).Locked = False
      wsTempSheet.Range("checkBC_2").cells(1, 2).Interior.ColorIndex = colorGreen
      wsTempSheet.cells(wsTempSheet.Range("checkBC_2").cells(2, 1).Row, _
                        wsTempSheet.Range("Consecutive_number").cells(1, 1).Column).Value = "1.2"
      If InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionOne) Then
        wsTempSheet.cells(wsTempSheet.Range("checkBC_2").cells(2, 1).Row, _
                          wsTempSheet.Range("Consecutive_number").cells(1, 1).Column).Offset(1, 0).Value = "1.3"
      End If
    Else
      intVisibleSheetArray = 2
      intVisibleSheetHyp = 2
    End If
    
    modServiceModule.PROTECT_SHEET wsTempSheet, True
        
    If InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionOne) = 0 And _
       InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionTwo) = 0 And _
       InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionThree) = 0 And _
       InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionFour) = 0 Then
    
        wsTempSheet.Visible = intVisibleSheetHyp
    
        ' список листов
        For intCounter = LBound(strNameSheetArray) To UBound(strNameSheetArray) - 1
          Set wsTempSheet = wbBook.Sheets(strNameSheetArray(intCounter))
          wsTempSheet.Activate
          wsTempSheet.Visible = intVisibleSheetArray
        Next
    
    End If
    
    GoTo cleanUp

  End If

  ' Признак филиала
  Set ISect = Application.Intersect(Target, wsSheet.Range("fil_flag"))
  If Not ISect Is Nothing Then
        
    modServiceModule.UNPROTECT_SHEET wsSheet
     
    If Target.cells(1, 1).Value = "да" Then
      wsSheet.Range("fil").RowHeight = 25
      wsSheet.Range("fil").Select
      Selection.Interior.ColorIndex = colorCyan
      Selection.Locked = False
    Else
      wsSheet.Range("fil").RowHeight = 0
      wsSheet.Range("fil").Select
      Selection.ClearContents
      Selection.Interior.ColorIndex = colorWhite
      Selection.Locked = True
    End If
      
    Target.Select
    wsSheet.Range("org_zag").cells(1, 1).Value = modTitleSheetHeaders.fil_org(Target.cells(1, 1).Value)
    wsSheet.Range("inn_zag").cells(1, 1).Value = modTitleSheetHeaders.fil_inn(Target.cells(1, 1).Value)
    wsSheet.Range("kpp_zag").cells(1, 1).Value = modTitleSheetHeaders.fil_kpp(Target.cells(1, 1).Value)
    
    modServiceModule.PROTECT_SHEET wsSheet, True
    
    GoTo cleanUp
    
  End If
  
  ' ВЫБОР МР
  Set ISect = Application.Intersect(Target, wsSheet.Range("mr_check"))
  If Not ISect Is Nothing Then
    
    modServiceModule.UNPROTECT_SHEET wsSheet
    intCounter = 2
    strMOName = ""
    Do While intCounter <= rngRange.Rows.Count + 1
      If wsTechSheet.cells(intCounter, 4).Value = Target.cells(1, 1).Value Then
        strMOName = wsTechSheet.cells(intCounter, 5).Value
        Exit Do
      End If
      intCounter = intCounter + 1
    Loop
    
    ' для начала проверим, а нет ли у нас такого значения в списке, если есть - ругаемся и не даем вводить
    strMRName = Target.cells(1, 1).Value
    If Len(Trim(strMRName)) <> 0 Then
      intNumStartRowForCheck = Target.cells(1, 1).Offset(0, -2).MergeArea.cells(1, 1).Row
      intNumEndRowForCheck = Target.cells(1, 1).Offset(0, -2).MergeArea.cells(Target.cells(1, 1).Offset(0, -2).MergeArea.Rows.Count, 1).Row
      
      For intCounter = intNumStartRowForCheck To intNumEndRowForCheck
        Set rngRangeTemp = wsSheet.cells(intCounter, wsSheet.Range("mr_check").Column).MergeArea.cells(1, 1)
        If rngRangeTemp.Value = strMRName And rngRangeTemp.Row = intCounter And _
           rngRangeTemp.Row <> Target.Row And Len(rngRangeTemp.Value) <> 0 Then
          MsgBox "Выбранный Вами муниципальный район уже присутствует в списке (в ячейке " & _
                 rngRangeTemp.Address & _
                 ")!", vbCritical, "Ошибка"
          Target.MergeArea.ClearContents
          strMRName = ""
          strMOName = ""
        End If
      Next
    End If
    
    intCounter = Target.cells(1, 1).Row
    Do While InStr(wsSheet.cells(intCounter, wsSheet.Range("mo_check").Column).Value, "Добавить") = 0
        wsSheet.cells(intCounter, wsSheet.Range("oktmo_check").Column).Select
        Selection.ClearContents
        wsSheet.cells(intCounter, wsSheet.Range("mo_check").Column).Select
        Selection.ClearContents
        Selection.Validation.Delete
        If Len(strMOName) > 0 Then
          With Selection.Validation
                        .Add Type:=xlValidateList, _
                             AlertStyle:=xlValidAlertStop, _
                             Operator:=xlBetween, _
                             Formula1:="=" & strMOName
                        .IgnoreBlank = False
                        .InCellDropdown = True
                        .InputTitle = ""
                        .ErrorTitle = "Выбор муниципального образования"
                        .InputMessage = "Выберите значение из списка"
                        .ErrorMessage = "Выберите наименование муниципального образования из списка"
                        .ShowInput = True
                        .ShowError = True
          End With
          Target.cells(1, 1).Offset(0, 1).Select
        Else
          With Selection.Validation
                        .Add Type:=xlValidateTextLength, _
                             AlertStyle:=xlValidAlertStop, _
                             Operator:=xlEqual, Formula1:="0"
                        .IgnoreBlank = False
                        .InCellDropdown = True
                        .InputTitle = ""
                        .ErrorTitle = "Выбор муниципального образования"
                        .InputMessage = ""
                        .ErrorMessage = "Для данного муниципального района отсутствуют муниципальные образования или Вы ввели некорректное наименование муниципального района!"
                        .ShowInput = True
                        .ShowError = True
          End With
          Target.cells(1, 1).Select
        End If
        intCounter = intCounter + 1
    Loop
    
    If Len(strMOName) > 0 Then
      modServiceModule.AutoFitMergedCellRowHeight Target
    End If
    
    modServiceModule.PROTECT_SHEET wsSheet, True
    
    GoTo cleanUp
    
  End If

  ' ВЫБОР МО
  Set ISect = Application.Intersect(Target, wsSheet.Range("mo_check"))
  If Not ISect Is Nothing Then
    
    modServiceModule.UNPROTECT_SHEET wsSheet
    
    ' для начала проверим, а нет ли у нас такого значения в списке, если есть - ругаемся и не даем вводить
    strMRName = Target.cells(1, 1).Offset(0, -1).MergeArea.cells(1, 1).Value
    strMOName = Target.cells(1, 1).Value
    If Len(Trim(strMOName)) <> 0 Then
      intNumStartRowForCheck = Target.cells(1, 1).Offset(0, -1).MergeArea.cells(1, 1).Row
      intNumEndRowForCheck = Target.cells(1, 1).Offset(0, -1).MergeArea.cells(Target.cells(1, 1).Offset(0, -1).MergeArea.Rows.Count, 1).Row
      
      For intCounter = intNumStartRowForCheck To intNumEndRowForCheck
        Set rngRangeTemp = wsSheet.cells(intCounter, wsSheet.Range("mo_check").Column).MergeArea.cells(1, 1)
        If rngRangeTemp.Value = strMOName And rngRangeTemp.Row = intCounter And _
           rngRangeTemp.Row <> Target.Row And Len(rngRangeTemp.Value) <> 0 Then
            MsgBox "Выбранное Вами муниципальное образование уже присутствует для указанного муниципального района (в ячейке " & _
                   rngRangeTemp.Address & _
                   ")!", vbCritical, "Ошибка"
            Target.ClearContents
            strMOName = ""
            strOKTMOValue = ""
        End If
      Next
    End If
    
    intCounter = 2
    Do While intCounter <= wsTechSheet.UsedRange.Rows.Count
      If wsTechSheet.cells(intCounter, 2).Value = Target.cells(1, 1).Value And _
         strMRName = wsTechSheet.cells(intCounter, 1).Value Then
        strOKTMOValue = wsTechSheet.cells(intCounter, 3).Value
        Exit Do
      End If
      intCounter = intCounter + 1
    Loop
    
    Target.cells(1, 1).Offset(0, 1).Select
    Selection.ClearContents
    Selection.Value = strOKTMOValue
    
    Target.EntireRow.AutoFit
    If Target.cells(1, 1).RowHeight < 15 Then Target.cells(1, 1).RowHeight = 15
   
    modServiceModule.PROTECT_SHEET wsSheet, True
    
    GoTo cleanUp
    
  End If

  GoTo cleanUp

ErrWsTitChange:
  Debug.Print Err.Description
  GoTo cleanUp
cleanUp:
  Application.EnableEvents = blnValueEnableEvents
  Application.ScreenUpdating = blnValueScreenUpdating
  wsSheet.Activate
  Set wbBook = Nothing
  Set rngRange = Nothing
  Set wsTechSheet = Nothing
  
End Sub

' остальные листы
Public Sub WsGeneralChange(Target As Range)
  On Error GoTo ErrWsTitChange
  
  Dim wbBook As Workbook
  
  Dim wsSheet As Worksheet
    
  Dim intNRow As Integer
  Dim intNColumn As Integer
  Dim intRowHeight As Integer
    
  blnValueEnableEvents = Application.EnableEvents
  blnValueScreenUpdating = Application.ScreenUpdating
  
  Application.EnableEvents = False
  Application.ScreenUpdating = False

  Set wbBook = Me.parent
  Set wsSheet = Target.parent
    
  intNRow = Target.cells(1, 1).Row
  intNColumn = Target.cells(1, 1).Column
  
  If Target.cells(1, 1).Row > 6 And Target.cells(1, 1).Row > 3 Then
    If Target.MergeCells Then
      modServiceModule.UNPROTECT_SHEET Me
      modServiceModule.AutoFitMergedCellRowHeight Target
      modServiceModule.PROTECT_SHEET Me, False
    Else
      Target.cells(1, 1).EntireRow.AutoFit
      intRowHeight = Target.cells(1, 1).RowHeight
      If intRowHeight < 15 Then Target.cells(1, 1).RowHeight = 15
    End If
  End If
  
  If wsSheet.name = gstrHyperlinkSheetName Then
    If (Target.cells(1, 1).Interior.ColorIndex = colorYellow Or _
        Target.cells(1, 1).Interior.ColorIndex = colorCyan) And _
       Target.cells(1, 1).Column = wsSheet.Range("Number_of_publication").Column Then
      If Len(Trim(Target.cells(1, 1).Value)) <> 0 And InStr(1, Target.cells(1, 1).Value, "№") = 0 Then
        Target.cells(1, 1).Value = "№ " & Target.cells(1, 1).Value
      End If
    End If
  End If
  
  GoTo cleanUp

ErrWsTitChange:
  Debug.Print Err.Description
  GoTo cleanUp
  
cleanUp:
  Application.EnableEvents = blnValueEnableEvents
  Application.ScreenUpdating = blnValueScreenUpdating
  
End Sub


Attribute VB_Name = "modRegionSelect"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Control = "cmdStartTemplate, 1, 0, MSForms, CommandButton"
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'       ОПИСАНИЕ
'
' Лист для выбора региона
' После копирования обязательно запустить функцию ChangeMacros()!!!!
' В шаблоне должен быть стандартный список регионов с именем REGION и
' стандартный модуль modServiceModule с функциями UNPROTECT_SHEET и PROTECT_SHEET
' Свой код нужно поместить в функцию StartTemplate
'
' Косарев Александр, 2011
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''' функция переделывает привязку макросов
''Private Sub ChangeMacros()
''  Dim sh As Shape
''  On Error Resume Next
''  For Each sh In Me.Shapes
''    If sh.name <> "cmdStart" Then sh.OnAction = "modRegionSelect.RegionClick"
''  Next sh
''  Me.Range("F2").name = "SelectedRegion"
''  With Me.Range("F3:I3").Validation
''    .Delete
''    .Add Type:=xlValidateList, _
''         AlertStyle:=xlValidAlertStop, _
''         Operator:=xlBetween, _
''         Formula1:="=REGION"
''    .IgnoreBlank = False
''    .InCellDropdown = True
''    .ShowInput = True
''    .ShowError = True
''  End With
''End Sub

' нажали кнопку выбора
Private Sub cmdStartTemplate_Click()
  StartTemlate
End Sub

' изменение значения в поле "Выбор региона"
Private Sub Worksheet_Change(ByVal Target As Range)
  If Me.Range("valueSelectedRegion").cells(1, 1).Row = Target.cells(1, 1).Row And _
     Me.Range("valueSelectedRegion").cells(1, 1).Column = Target.cells(1, 1).Column Then
        Dim rngFind As Range
        Dim rngFound As Range
        Set rngFind = ThisWorkbook.Names("REGION").RefersToRange
        Set rngFound = rngFind.Find(Target.cells(1, 1).Value, lookat:=xlWhole)
        If Not rngFound Is Nothing Then
          RePaintRegion (rngFound.Row - ThisWorkbook.Names("REGION").RefersToRange.cells(1, 1).Row + 1)
        Else
          RePaintRegion (0)
        End If
  End If
End Sub

' нажатие на регион
Sub RegionClick()
  Dim i As Integer
  ' для островов
  If InStr(Application.Caller, "Groupp") <> 0 Then
    i = CInt(Mid(Application.Caller, 7, 2))
  Else
    i = CInt(Mid(Application.Caller, 10))
  End If
  If i > 84 Then Exit Sub
  Application.EnableEvents = False
  Me.Range("valueSelectedRegion").Value = ThisWorkbook.Names("REGION").RefersToRange.cells(i, 1).Value
  Application.EnableEvents = True
  RePaintRegion (i)
End Sub

' раскраска региона
Public Sub RePaintRegion(intRegNumber As Integer)
  If intRegNumber = ThisWorkbook.Names("SelectedRegion").RefersToRange.Value Then Exit Sub
  modServiceModule.UNPROTECT_SHEET Me
  On Error GoTo end_info
  If intRegNumber <> 0 Then
    With Me.Shapes("ShapeReg_" & intRegNumber)
      .Fill.ForeColor.RGB = RGB(186, 255, 204)
      .Fill.Visible = msoTrue
      .Fill.Solid
    End With
  End If

  If ThisWorkbook.Names("SelectedRegion").RefersToRange.Value <> 0 Then
    With Me.Shapes("ShapeReg_" & ThisWorkbook.Names("SelectedRegion").RefersToRange.Value)
      .Fill.ForeColor.RGB = RGB(220, 220, 220)
      .Fill.Visible = msoTrue
      .Fill.Solid
    End With
  End If
end_info:
  ThisWorkbook.Names("SelectedRegion").RefersToRange.Value = intRegNumber
  modServiceModule.PROTECT_SHEET Me, True
End Sub

' приступить к заполнению
Sub StartTemlate()
  On Error GoTo ErrHandler

  Dim wbBook As Workbook
  
  Dim wsSheet As Worksheet
  Dim wsTempSheet As Worksheet
  Dim wsTitleSheet As Worksheet
  Dim wsEtUnionSheet As Worksheet
  
  Dim strRegionName As String
  Dim strDelForHypSheet As String
  Dim strDelForEtUnionSheet As String

  Set wbBook = ThisWorkbook

  If modServiceModule.IsNameExists(wbBook, "valueSelectedRegion") = False Or _
     modServiceModule.IsNameExists(wbBook, "region_name") = False Then GoTo cleanUp
  
  Set wsSheet = wbBook.Names("valueSelectedRegion").RefersToRange.parent
  strRegionName = wsSheet.Range("valueSelectedRegion").cells(1, 1).Value
  If strRegionName = "" Then
    MsgBox "Необходимо выбрать регион!", vbCritical
    wsSheet.Range("valueSelectedRegion").Select
  Else
    If MsgBox("Вы уверены в выборе региона: '" & strRegionName & "' ?", vbYesNo + vbQuestion, "Подтверждение!") = vbYes Then
      Application.EnableEvents = False
      Application.ScreenUpdating = False
      modServiceModule.UNPROTECT_SHEET wsSheet
      ' убираем выпадающий список из выбора региона
      wsSheet.Range("valueSelectedRegion").cells(1, 1).MergeArea.Validation.Delete
      wsSheet.Range("valueSelectedRegion").cells(1, 1).MergeArea.Locked = True
      wsSheet.Range("valueSelectedRegion").cells(1, 1).Interior.ColorIndex = colorGreen
      ' убираем кнопку
      cmdStartTemplate.Enabled = False
      cmdStartTemplate.Visible = False
      ' скрываем лист
      wsSheet.Visible = xlSheetVeryHidden
      modServiceModule.PROTECT_SHEET wsSheet, True

'****************************************************************************************************************************
' ЗДЕСЬ ПОМЕЩАЕМ КОД, КОТОРЫЙ НУЖЕН ПРИ ВЫБОРЕ РЕГИОНА
''****************************************************************************************************************************
      Set wsTitleSheet = wbBook.Names("region_name").RefersToRange.parent
      wsTitleSheet.Activate
      modServiceModule.UNPROTECT_SHEET wsTitleSheet
      wsTitleSheet.Range("region_name").cells(1, 1).Value = strRegionName
      modServiceModule.PROTECT_SHEET wsTitleSheet, True
      
      MsgBox "Сейчас будет выполнено обновление реестров МО и организаций для выбранного Вами региона. Это может занять несколько минут, не закрывайте приложение!", _
             vbInformation, "Внимание!"
      
      Application.ScreenUpdating = False
      Application.StatusBar = "ВНИМАНИЕ! Идет обновление реестра организаций! Подождите..."
      modCommandButton.cmdUpdateOrgData_Click_Handler wsTitleSheet, Nothing, False
      Application.StatusBar = "ВНИМАНИЕ! Идет обновление реестра МО! Подождите..."
      modCommandButton.cmdUpdateReestrMO_Click_Handler wsTitleSheet, Nothing, False
      Application.StatusBar = False
      
      Application.ScreenUpdating = False
      For Each wsTempSheet In wbBook.Worksheets
        If Not (wsTempSheet.Visible = True) Then
          If wsTempSheet.Tab.ColorIndex = colorPaleBlue Then
            wsTempSheet.Visible = xlSheetVisible
          End If
        End If
      Next wsTempSheet
      
      ' Скорректируем лист Ссылки на публикации
      Application.EnableEvents = False
      Set wsTempSheet = wbBook.Sheets(gstrHyperlinkSheetName)
      Set wsEtUnionSheet = wbBook.Sheets(gstrEtUnionSheetName)
      wsTempSheet.Activate
      modServiceModule.UNPROTECT_SHEET wsTempSheet
      If InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionOne) = 0 Then
        wsTempSheet.Range("forSPb").EntireRow.Delete
        wbBook.Names("forSPb").Delete
      End If
      modServiceModule.PROTECT_SHEET wsTempSheet, True
      
      ' очищаем поле Публикация на листе Титульный
      wsTitleSheet.Activate
      modServiceModule.UNPROTECT_SHEET wsTitleSheet
      Application.EnableEvents = True
      wsTitleSheet.Range("strPublication").ClearContents
      If InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionOne) Or _
         InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionTwo) Or _
         InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionThree) Or _
         InStr(wbBook.Names("region_name").RefersToRange.Value, strExceptionsRegionFour) Then
        wsTitleSheet.Range("strHelpPublication").cells(1, 1).Value = ""
      End If
      modServiceModule.PROTECT_SHEET wsTitleSheet, False
      Application.EnableEvents = False

'****************************************************************************************************************************
'
'****************************************************************************************************************************
    
    End If

  End If
  
  GoTo cleanUp

ErrHandler:
  GoTo cleanUp
  
cleanUp:
  wsSheet.Activate
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Application.StatusBar = False
End Sub

Attribute VB_Name = "modClassifierValidate"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit

' Проверка длины строки и числовых знаков
Private Function blnValidate_Len_Number(strValue As String, _
                                        intMinLen As Integer, _
                                        intMaxLen As Integer) As Boolean
                                        
  Dim intCounter As Integer
  
  blnValidate_Len_Number = False
  If intMinLen <= 0 Or intMinLen <= 0 Then Exit Function
  
  If Len(strValue) = 0 Then ' пустая строка
    blnValidate_Len_Number = True ' не проверять такое поле, считать его валидным
    Exit Function
  End If
  
  If Len(strValue) > intMaxLen Or Len(strValue) < intMinLen Then
    Exit Function
  End If
  
  For intCounter = 1 To Len(strValue)
    If Mid(strValue, intCounter, 1) < "0" Or Mid(strValue, intCounter, 1) > "9" Then
      Exit Function
    End If
  Next intCounter
  
  blnValidate_Len_Number = True

End Function

' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------
' ----------------------------- ПРОВЕРКА на форме ---------------------------------
' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------

' ПРОВЕРКА ИНН на форме
Public Function blnValidate_INN_OnForm(strINN As String, _
                                       Optional blnMsgBoxShow As Boolean = True) As Boolean
                                       
  blnValidate_INN_OnForm = False
  
  If blnValidate_Len_Number(strINN, 10, 12) = False Then
    GoTo ErrHandler
  Else
    GoTo Success
  End If
  
Success:
  blnValidate_INN_OnForm = True
  GoTo cleanUp
ErrHandler:
  blnValidate_INN_OnForm = False
  If blnMsgBoxShow = True Then
    MsgBox "ИНН введён не верно! ИНН должен содержать 10-12 числовых знаков! Добавление невозможно!", _
           vbCritical, "Предупреждение"
  End If
  GoTo cleanUp
cleanUp:
  Exit Function
  
End Function

' ПРОВЕРКА КПП на форме
Public Function blnValidate_KPP_OnForm(strKPP As String, _
                                       Optional blnMsgBoxShow As Boolean = True) As Boolean
                                       
  blnValidate_KPP_OnForm = False
  
  If LCase(Trim(strKPP)) = "не определено" Or _
     LCase(Trim(strKPP)) = "отсутствует" Then
        GoTo Success
  ElseIf blnValidate_Len_Number(strKPP, 9, 9) = False Then
        GoTo ErrHandler
  Else
        GoTo Success
  End If
  
Success:
  blnValidate_KPP_OnForm = True
  GoTo cleanUp
ErrHandler:
  blnValidate_KPP_OnForm = False
  If blnMsgBoxShow = True Then
    MsgBox "КПП введён не верно! КПП должен содержать 9 числовых знаков! Добавление невозможно!", _
           vbCritical, "Предупреждение"
  End If
  GoTo cleanUp
cleanUp:
  Exit Function
  
End Function

' ПРОВЕРКА ОКТМО на форме
Public Function blnValidate_OKTMO_OnForm(strOKTMO As String, _
                                         Optional blnMsgBoxShow As Boolean = True) As Boolean
                                         
  blnValidate_OKTMO_OnForm = False
  
  If blnValidate_Len_Number(strOKTMO, 7, 8) = False Then
    GoTo ErrHandler
  Else
    GoTo Success
  End If
  
Success:
  blnValidate_OKTMO_OnForm = True
  GoTo cleanUp
ErrHandler:
  blnValidate_OKTMO_OnForm = False
  If blnMsgBoxShow = True Then
    MsgBox "ОКТМО введён не верно! ОКТМО должен содержать 7-8 числовых знаков! Добавление невозможно!", _
           vbCritical, "Предупреждение"
  End If
  GoTo cleanUp
cleanUp:
  Exit Function
  
End Function

' ПРОВЕРКА ОКАТО на форме
Public Function blnValidate_OKATO_OnForm(strOKATO As String, _
                                         Optional blnMsgBoxShow As Boolean = True) As Boolean
                                         
  blnValidate_OKATO_OnForm = False
  
  If blnValidate_Len_Number(strOKATO, 7, 11) = False Then
    GoTo ErrHandler
  Else
    GoTo Success
  End If
  
Success:
  blnValidate_OKATO_OnForm = True
  GoTo cleanUp
ErrHandler:
  blnValidate_OKATO_OnForm = False
  If blnMsgBoxShow = True Then
    MsgBox "ОКАТО введён не верно! ОКАТО должен содержать 7-11 числовых знаков! Добавление невозможно!", _
           vbCritical, "Предупреждение"
  End If
  GoTo cleanUp
cleanUp:
  Exit Function
  
End Function

' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------
' ----------------------------- ПРОВЕРКА на листе ---------------------------------
' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------

' ПРОВЕРКА ИНН на листе
Public Function blnValidate_INN_OnSheet(rngValidatingRange As Range, _
                                Optional blnMsgBoxShow As Boolean = True) As Boolean
                                
  blnValidate_INN_OnSheet = False
  
  If rngValidatingRange Is Nothing Then
    GoTo cleanUp
  End If
  
  If blnValidate_Len_Number(CStr(rngValidatingRange.cells(1, 1).Value), 10, 12) = False Then
    GoTo ErrHandler
  Else
    GoTo Success
  End If
  
Success:
  blnValidate_INN_OnSheet = True
  GoTo cleanUp
ErrHandler:
  blnValidate_INN_OnSheet = False
  If blnMsgBoxShow = True Then
    MsgBox "ИНН введён не верно! Ячейка '" & rngValidatingRange.Address & "'!", _
           vbOKOnly + vbExclamation, "Предупреждение"
  End If
  rngValidatingRange.parent.Activate
  rngValidatingRange.Activate
  GoTo cleanUp
cleanUp:
  Exit Function
  
End Function

' ПРОВЕРКА КПП на листе
Public Function blnValidate_KPP_OnSheet(rngValidatingRange As Range, _
                                        Optional blnMsgBoxShow As Boolean = True) As Boolean
                                        
  blnValidate_KPP_OnSheet = False
  
  If rngValidatingRange Is Nothing Then
    GoTo cleanUp
  End If
  
  If LCase(Trim(CStr(rngValidatingRange.cells(1, 1).Value))) = "не определено" Or _
     LCase(Trim(CStr(rngValidatingRange.cells(1, 1).Value))) = "отсутствует" Then
        GoTo Success
  ElseIf blnValidate_Len_Number(CStr(rngValidatingRange.cells(1, 1).Value), 9, 9) = False Then
        GoTo ErrHandler
  Else
        GoTo Success
  End If
  
Success:
  blnValidate_KPP_OnSheet = True
  GoTo cleanUp
ErrHandler:
  blnValidate_KPP_OnSheet = False
  If blnMsgBoxShow = True Then
    MsgBox "ОКАТО введён не верно! ОКАТО должен содержать 7-11 числовых знаков! Добавление невозможно!", _
           " Ячейка '" & rngValidatingRange.Address & "'!", vbCritical, "Предупреждение"
  End If
  rngValidatingRange.parent.Activate
  rngValidatingRange.Activate
  GoTo cleanUp
cleanUp:
  Exit Function
  
End Function

' ПРОВЕРКА ОКТМО на листе
Public Function blnValidate_OKTMO_OnSheet(rngValidatingRange As Range, _
                                          Optional blnMsgBoxShow As Boolean = True) As Boolean
                                          
  blnValidate_OKTMO_OnSheet = False
  
  If rngValidatingRange Is Nothing Then
    GoTo cleanUp
  End If
  
  If blnValidate_Len_Number(CStr(rngValidatingRange.cells(1, 1).Value), 7, 8) = False Then
    GoTo ErrHandler
  Else
    GoTo Success
  End If
  
Success:
  blnValidate_OKTMO_OnSheet = True
  GoTo cleanUp
ErrHandler:
  blnValidate_OKTMO_OnSheet = False
  If blnMsgBoxShow = True Then
    MsgBox "ОКТМО введён не верно! ОКТМО должен содержать 9 числовых знаков! Добавление невозможно!", _
           " Ячейка '" & rngValidatingRange.Address & "'!", vbCritical, "Предупреждение"
  End If
  rngValidatingRange.parent.Activate
  rngValidatingRange.Activate
  GoTo cleanUp
cleanUp:
  Exit Function
  
End Function

' ПРОВЕРКА ОКАТО на листе
Public Function blnValidate_OKATO_OnSheet(rngValidatingRange As Range, _
                                          Optional blnMsgBoxShow As Boolean = True) As Boolean
                                          
  blnValidate_OKATO_OnSheet = False
  
  If rngValidatingRange Is Nothing Then
    GoTo cleanUp
  End If
  
  If blnValidate_Len_Number(CStr(rngValidatingRange.cells(1, 1).Value), 7, 11) = False Then
    GoTo ErrHandler
  Else
    GoTo Success
  End If
  
Success:
  blnValidate_OKATO_OnSheet = True
  GoTo cleanUp
ErrHandler:
  blnValidate_OKATO_OnSheet = False
  If blnMsgBoxShow = True Then
    MsgBox "ОКАТО введён не верно! ОКАТО должен содержать 7-11 числовых знаков! Добавление невозможно!", _
           " Ячейка '" & rngValidatingRange.Address & "'!", vbCritical, "Предупреждение"
  End If
  rngValidatingRange.parent.Activate
  rngValidatingRange.Activate
  GoTo cleanUp
cleanUp:
  Exit Function
  
End Function

' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------
' -------------------- ПРОВЕРКА на листе, возвращает строку -----------------------
' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------

' ПРОВЕРКА ИНН на листе, возвращает строку
Public Function strValidate_INN_OnSheet(rngValidatingRange As Range) As String

  strValidate_INN_OnSheet = "Проверка не может быть выполнена!"
  
  If rngValidatingRange Is Nothing Then
    GoTo cleanUp
  End If
  
  If blnValidate_Len_Number(CStr(rngValidatingRange.cells(1, 1).Value), 10, 12) = False Then
    GoTo ErrHandler
  Else
    GoTo Success
  End If
  
Success:
  strValidate_INN_OnSheet = ""
  GoTo cleanUp
ErrHandler:
  strValidate_INN_OnSheet = "ИНН введён не верно! Ячейка '" & rngValidatingRange.Address & "'!"
  GoTo cleanUp
cleanUp:
  Exit Function
  
End Function

' ПРОВЕРКА КПП на листе, возвращает строку
…