Malicious Office (OLE) — malware analysis report

Static analysis result for SHA-256 e07753dbefc4959a…

MALICIOUS

Office (OLE)

2.52 MB Created: 2004-05-21 07:18:45 Authoring application: Microsoft Excel First seen: 2018-06-30
MD5: e97d64cf761df1d3093bb0d3a467a831 SHA-1: 2571d3681e1153e850b3a1d0e94447bfc4cc159d SHA-256: e07753dbefc4959acb5bc4a0fc58431d86019394dbb24e12523a326b8db9c6e4
150 Risk Score

Malware Insights

MITRE ATT&CK
T1059.005 Visual Basic T1566.001 Spearphishing Attachment T1203 Exploitation for Client Execution

The sample is an Excel document containing VBA macros, specifically a Workbook_Open macro that executes code upon opening. This macro uses CreateObject and ShellExecute API calls, indicating an attempt to download and execute a second-stage payload. The presence of numerous unknown URLs suggests potential C2 communication or payload hosting. The document body contains financial and reporting terms, likely a lure.

Heuristics 6

  • Reference to ShellExecute API high SC_STR_SHELLEXEC
    Reference to ShellExecute API
  • VBA macros detected medium 3 related findings OLE_VBA_MACROS
    Document contains VBA macro code
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
      Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Compiled VBA/cache stream contains an auto-execution token together with shell/download/object-execution tokens. This catches p-code-only or source-extraction-failure macro documents where visible source is unavailable.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Sub Workbook_Open()
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL http://www.fstrf.ru/regions/region/showlistY In document text (OLE body)
    • https://tariff.eias.ru/procwsxls/In document text (OLE body)
    • https://appsrv02.eias.ru/procwsxls/In document text (OLE body)
    • https://appsrv01.eias.ru/procwsxls/In document text (OLE body)
    • https://eias.fstrf.ru/procwsxls/In document text (OLE body)
    • https://eias.fstrf.ru/procwsxls/�In document text (OLE body)
    • http://ipgeobase.ru:7020/geo?ip=In document text (OLE body)
    • http://support.eias.ru/index.php?a=add&catid=34In document text (OLE body)
    • http://support.eias.ru/index.php?a=addIn document text (OLE body)
    • http://www.fstrf.ru/regions/region/showlistIn document text (OLE body)
    • http://www.eias.ru/templates/In document text (OLE body)
    • http://schemas.openxmlformats.org/drawingml/2006/mainIn document text (OLE body)
    • http://checkip.dyndns.orgIn document text (OLE body)
    • http://www.w3.org/1999/02/22-rdf-syntax-ns#In document text (OLE body)
    • http://ns.adobe.com/xap/1.0/In document text (OLE body)
    • http://ns.adobe.com/xap/1.0/mm/In document text (OLE body)
    • http://ns.adobe.com/xap/1.0/sType/ResourceRef#In document text (OLE body)

Extracted artifacts 1

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source) 667681 bytes
SHA-256: 0cbfbd2f0ff2c0cdd22e2028db5ba18cae9487c08cf29dba20ac401b0d140304
Preview script
First 1,000 lines of the extracted script
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 = "Результат проверки"

Public Sub VLD_EXT_CALL()
  Workbook_BeforeSave True, True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  
  On Error GoTo ErrHandler
  
  Application.Calculate
    
  Application.ReferenceStyle = xlA1
  
  ' Если не выбран регион - нечего проверять
  If modServiceModule.IsNameExists(Me, "region_name") = False Then
    GoTo CleanUp
  End If
  
  If Len(CStr(Me.Names("region_name").RefersToRange.cells(1, 1).Value)) = 0 Then
    GoTo CleanUp
  End If
  
  If vbYes = MsgBox("Проверка отчёта может занять некоторое время. " & _
                    "Запустить процедуру проверки отчёта?", vbInformation + vbYesNo, modGlobals.STR_MSGBOX_INFORMATION_TITLE) Then
  
    If modScrolling.blnIs_UserForm_Loaded("frmValidationInProgress") = True Then
      Unload frmValidationInProgress
    End If
    
    frmValidationInProgress.cmdOK.caption = frmValidationInProgress.cmdOK.caption & vbNullString
    DoEvents
    
    modVLDCommonProv.Perform_Validation Me
    
    frmValidationInProgress.cmdOK.Enabled = True
    modCommonProcedures.App_Window_Activate
  
    If modGlobals.glngCriticalImpactWarningsCounter > 0 Then
      Me.CustomDocumentProperties("Status") = 1 'ТРАНС
      frmValidationInProgress.lblGeneralResult.caption = SAVE_STATUS_CRITICAL_IMPACT_WARNING
      frmValidationInProgress.imgCriticalWarnings.Visible = True
      Me.Worksheets("Проверка").Activate
    ElseIf modGlobals.glngLowImpactWarningsCounter > 0 Then
      Me.CustomDocumentProperties("Status") = 1 'ТРАНС
      frmValidationInProgress.lblGeneralResult.caption = SAVE_STATUS_LOW_IMPACT_WARNING
      frmValidationInProgress.imgLowImpactWarnings.Visible = True
      Me.Worksheets("Проверка").Activate
    Else 'ТРАНС
      Me.CustomDocumentProperties("Status") = 2 'ТРАНС
      frmValidationInProgress.lblGeneralResult.caption = Chr(10) & SAVE_STATUS_SUCCESS
      frmValidationInProgress.imgNoIssues.Visible = True
    End If
    
    If modServiceModule.blnIsDocumentProperty(Me, "Status") = True Then
      If Me.CustomDocumentProperties("Status") > 2 Then
        MsgBox "Документ подписан ЭЦП и не может быть изменен", vbExclamation + vbOKOnly, modGlobals.STR_MSGBOX_WARNING_TITLE
        Cancel = True
        GoTo CleanUp
      End If
    End If
  
  End If
  
  GoTo CleanUp
  
ErrHandler:
  MsgBox Err.Description, vbOKOnly + vbExclamation, modGlobals.STR_MSGBOX_WARNING_TITLE
  GoTo CleanUp
CleanUp:
  Me.Application.ScreenUpdating = True
  If ActiveSheet.name = "Проверка" Then
    ActiveSheet.Range("A1").Select
  End If
End Sub

Private Sub Workbook_Open()
  
  On Error GoTo ErrHandler
  
  Me.Application.ScreenUpdating = False
  
  Instruction.Rearrange_Shapes
  
  If modServiceModule.blnIsDocumentProperty(Me, "Status") = True Then
    Me.CustomDocumentProperties("Status") = 1 'ТРАНС
  End If
  
  Me.Application.Calculation = xlCalculationAutomatic
  
  If modGlobals.gblnTestMode = False Then
    If modServiceModule.IsNameExists(Me, "region_name") = True Then
      If Len(CStr(Me.Names("region_name").RefersToRange.cells(1, 1).Value)) = 0 Then
        Me.Worksheets(modGlobals.gstrMainSheetName).Visible = xlVeryHidden
        Me.Worksheets("Проверка").Visible = xlVeryHidden
        Me.Worksheets("Свод").Visible = xlVeryHidden
        Me.Worksheets("Результаты загрузки").Visible = xlVeryHidden
        Me.Worksheets("Контакты").Visible = xlVeryHidden
        Me.Worksheets("ВД").Visible = xlVeryHidden
        Me.Worksheets("Т итого").Visible = xlVeryHidden
        Me.Worksheets("Комментарии").Visible = xlVeryHidden
        Me.Worksheets("Инструкция").Activate
        modServiceModule.UNPROTECT_SHEET Me.Worksheets("Инструкция")
        Me.Worksheets("Инструкция").Shapes("cmdRegionChange").Visible = True
      End If
    End If
  End If

  ' Попытка определить регион
  If modServiceModule.IsNameExists(Me, "region_name") = True Then
    If Len(Me.Names("region_name").RefersToRange.cells(1, 1).Value) = 0 Then
      modGetGeoBase.Try_Define_Region
    End If
  End If
  
  ' Для обновления
  If modServiceModule.IsNameExists(Me, "chkGetUpdatesValue") = True Then
    If Me.Names("chkGetUpdatesValue").RefersToRange.cells(1, 1).Value = "y" Then
      modUpdTemplMain.Check_Update_Execution Me
    End If
  End If
  
  GoTo CleanUp
  
ErrHandler:
  GoTo CleanUp
CleanUp:
  If modServiceModule.SheetExists("Инструкция", Me) = True Then
    modServiceModule.PROTECT_SHEET Me.Worksheets("Инструкция"), True
  End If
  Me.Application.ScreenUpdating = True
End Sub

Attribute VB_Name = "frmSKIP"
Attribute VB_Base = "0{1F31E934-7D3C-4FFB-AF91-258F1456084A}{9FC203E9-8576-48C6-BD22-FD5E719CA10C}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit

Private Sub CmdProp_Click()
  STR_SKIP = "Пропускать"
  Unload frmSKIP
End Sub

Private Sub CmdSpr_Click()
  STR_SKIP = "Спрашивать"
  Unload frmSKIP
End Sub

Private Sub CmdZam_Click()
  STR_SKIP = "Заменять"
  Unload frmSKIP
End Sub

' определяем сообщение
Private Sub UserForm_Initialize()
  STR_SKIP = "Не определено"
  Label1.caption = "При полном совпадении реквизитов оргaнизаций из обратываемого отчёта с реквизитами организаций уже присутствующими в данном отчёте, перегружать данные об организациях в данный отчёт?"
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If STR_SKIP = "Не определено" Then
    Cancel = True
  End If
End Sub

Attribute VB_Name = "modLOST_INCOME"
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
Option Base 1

Public Sub Worksheet_Change_Handler(ByVal Target As Range)
  
  On Error GoTo ErrHandler
  
  GoTo CleanUp

ErrHandler:
  GoTo CleanUp
CleanUp:
End Sub

Sub Show_Used_Fuels(ByVal Target As Range)
  
  On Error GoTo ErrHandler

  Dim wbBook As Workbook
  Dim wsSheet As Worksheet
  Dim lngICounter As Long
  Dim lngColumn As Long
  
  Dim rngProcessing As Range
  
  Set wsSheet = Target.parent
  Set wbBook = wsSheet.parent
  
  Application.Calculate ' !!!
  
  If modServiceModule.IsNameExists(wbBook, "LI_TECH_USAGE_COLUMN_MARKER") = False Then
    GoTo CleanUp
  End If
  
  lngColumn = wbBook.Names("LI_TECH_USAGE_COLUMN_MARKER").RefersToRange.Column
  
  For lngICounter = 46 To wbBook.Names("LI_ADD_ORG_HL_MARKER").RefersToRange.Row - 1
  
    If Not wsSheet.cells(lngICounter, Target.Column).Value = "+" Then
       
      If Not wsSheet.cells(lngICounter, lngColumn).Value = 0 Then
        If Not rngProcessing Is Nothing Then
          Set rngProcessing = Union(rngProcessing, wsSheet.Rows(lngICounter))
        Else
          Set rngProcessing = wsSheet.Rows(lngICounter)
        End If
      End If
      
    End If
    
  Next lngICounter
  
  If Not rngProcessing Is Nothing Then
    rngProcessing.EntireRow.Hidden = False
  End If
  
  GoTo CleanUp

ErrHandler:
  GoTo CleanUp
CleanUp:
End Sub

Sub Show_Hide_Fuels_By_Org(ByVal Target As Range, _
                           ByVal blnHide As Boolean)
  
  On Error GoTo ErrHandler

  Dim wbBook As Workbook
  Dim wsSheet As Worksheet
  Dim lngICounter As Long
  Dim lngColumn As Long
  
  Dim lngStartRow As Long
  Dim lngEndRow As Long
  
  Dim rngProcessing As Range
  
  Set wsSheet = Target.parent
  Set wbBook = wsSheet.parent
  
  If modServiceModule.IsNameExists(wbBook, "LI_TECH_USAGE_COLUMN_MARKER") = False Or _
     modServiceModule.IsNameExists(wbBook, "LI_DELETE_FUEL_HL_COLUMN_MARKER") = False Or _
     modServiceModule.IsNameExists(wbBook, "LI_NUM_FUEL_HL_COLUMN_MARKER") = False Then
    GoTo CleanUp
  End If
  
  lngColumn = wbBook.Names("LI_TECH_USAGE_COLUMN_MARKER").RefersToRange.Column
  
  If Target.Row = Target.Offset(0, -7).MergeArea.Row Then
    ' Top controls
    lngStartRow = Target.Row + 1
    lngEndRow = Target.Row + Target.Offset(0, -7).MergeArea.Rows.Count - 2
  Else
    ' Bottom controls
    lngStartRow = Target.Offset(0, -7).MergeArea.Row + 1
    lngEndRow = Target.Row - 1
  End If
  
  ' wsSheet.UsedRange.Calculate
  
  wsSheet.Rows(lngStartRow & ":" & lngEndRow).Calculate
  
  For lngICounter = lngStartRow To lngEndRow
    If blnHide = False And _
       Len(wsSheet.cells(lngICounter, lngColumn).Value) > 0 Then
      If Not rngProcessing Is Nothing Then
        Set rngProcessing = Union(rngProcessing, wsSheet.Rows(lngICounter))
      Else
        Set rngProcessing = wsSheet.Rows(lngICounter)
      End If
    End If
    If blnHide = True And _
       wsSheet.cells(lngICounter, lngColumn).Value = 0 Then
      If Not rngProcessing Is Nothing Then
        Set rngProcessing = Union(rngProcessing, wsSheet.Rows(lngICounter))
      Else
        Set rngProcessing = wsSheet.Rows(lngICounter)
      End If
    End If
  Next lngICounter
  
  If Not rngProcessing Is Nothing Then
    rngProcessing.EntireRow.Hidden = blnHide
   End If
  
  GoTo CleanUp

ErrHandler:
  GoTo CleanUp
CleanUp:
End Sub

Public Sub Worksheet_BeforeDoubleClick_Handler(ByVal Target As Range, _
                                               ByRef Cancel As Boolean)
  
  On Error GoTo ErrHandler

  Dim blnApplicationEnableEventsPreference As Boolean
  Dim blnApplicationScreenUpdatingPreference As Boolean
  
  Dim wbBook As Workbook
  Dim wsSheet As Worksheet
  Dim wsMRMOSheet As Worksheet
  Dim lngICounter As Long
  
  blnApplicationEnableEventsPreference = Application.EnableEvents
  blnApplicationScreenUpdatingPreference = Application.ScreenUpdating
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  
  Set wsSheet = Target.parent
  Set wbBook = wsSheet.parent
  
  
  If modServiceModule.IsNameExists(wbBook, "LI_ORG_COLUMN_MARKER") = False Or _
     modServiceModule.IsNameExists(wbBook, "LI_DELETE_FUEL_HL_COLUMN_MARKER") = False Or _
     modServiceModule.IsNameExists(wbBook, "LI_NUM_FUEL_HL_COLUMN_MARKER") = False Then
    GoTo CleanUp
  End If
  
  
  ' ===============================================================================================================
  ' ===============================================================================================================
  
  If Target.Column = wbBook.Names("LI_DELETE_FUEL_HL_COLUMN_MARKER").RefersToRange.Column And _
     Target.Interior.ColorIndex = modDefines.colorPaleBlue And _
     Target.cells(1, 1).Value = "+" Then
    Show_Hide_Fuels_By_Org Target, False
    Cancel = True
    GoTo CleanUp
  End If
  
  ' ===============================================================================================================
  ' ===============================================================================================================
  
  If Target.Column = wbBook.Names("LI_NUM_FUEL_HL_COLUMN_MARKER").RefersToRange.Column And _
     Target.Interior.ColorIndex = modDefines.colorPaleBlue And _
     Target.cells(1, 1).Value = "-" Then
    Show_Hide_Fuels_By_Org Target, True
    Cancel = True
    GoTo CleanUp
  End If
  
  ' ===============================================================================================================
  ' ===============================================================================================================
  
  GoTo CleanUp

ErrHandler:
  GoTo CleanUp
CleanUp:
  Application.EnableEvents = blnApplicationEnableEventsPreference
  Application.ScreenUpdating = blnApplicationScreenUpdatingPreference
  If Not wsSheet Is Nothing Then
    modServiceModule.PROTECT_SHEET wsSheet, True
    wsSheet.Select
    Target.Select
  End If
End Sub

Public Sub Worksheet_FollowHyperlink_Handler(ByVal Target As Range)

  On Error GoTo ErrHandler

  Dim wsSheet As Worksheet
  
  Set wsSheet = Target.parent
  
  modDataRegion.Reset_Public_Org_Variables
      
  ' обработка нажатия гиперссылки
  ProcessHyperlink Target.cells(1, 1)

  GoTo CleanUp

ErrHandler:
  MsgBox Err.Description, vbOKOnly + vbExclamation, modGlobals.STR_MSGBOX_WARNING_TITLE
  GoTo CleanUp
CleanUp:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

' Обработка нажатия гиперссылки
Public Sub ProcessHyperlink(ByVal rngTarget As Range)

  On Error GoTo ErrHandler

  Dim blnScreenUpdatingPreference As Boolean
  Dim blnEnableEventsPreference As Boolean
  
  If Not modGlobals.LNG_MODE = AutomaticMode Then
  
    ' Сохранить текущие настройки ScreenUpdating, EnableEvents
    blnScreenUpdatingPreference = Application.ScreenUpdating
    blnEnableEventsPreference = Application.EnableEvents
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
  
  End If

  Dim lngRngTargetNRow As Long
  Dim lngRngTargetNCol As Long
  Dim lngDeleteColumnNumber As Long
  Dim wbThis As Workbook
  Dim wsRanges As Worksheet
  Dim wsActiveSheet As Worksheet
  Set wsActiveSheet = rngTarget.parent
  Set wbThis = wsActiveSheet.parent
  Set wsRanges = wbThis.Worksheets(modGlobals.gstrTechSheetName)
  
  Dim rngRange As Range
  Dim rngCell As Range
  Dim rngPCDRange As Range
  Dim rngNPCDRange As Range
  Dim rngNDSRange As Range
  Dim rngSTATUSRange As Range
  Dim rngSOURCERange As Range
  Dim rngNUMBERPLAN1XRange As Range
  Dim rngNUMBERORGRange As Range
  Dim rngNUMBERFUELRange As Range
  Dim wsMRMOSheet As Worksheet
  
  Dim strORGRangeName As String ' Имя диапазона для добавления организации
  Dim lngICounter As Long
  
  Dim vbMsgDeleteResult As VbMsgBoxResult
  
  lngRngTargetNRow = rngTarget.Row
  lngRngTargetNCol = rngTarget.Column
  
  If Not modGlobals.LNG_MODE = AutomaticMode Then
  
    If modServiceModule.IsNameExists(wbThis, "LI_EXCLUDE_ORG_REASON_HL_COLUMN_MARKER") = False Or _
       modServiceModule.IsNameExists(wbThis, "LI_DELETE_ORG_HL_COLUMN_MARKER") = False Or _
       modServiceModule.IsNameExists(wbThis, "LI_NUM_ORG_HL_COLUMN_MARKER") = False Or _
       modServiceModule.IsNameExists(wbThis, "LI_DELETE_FUEL_HL_COLUMN_MARKER") = False Or _
       modServiceModule.IsNameExists(wbThis, "LI_NUM_FUEL_HL_COLUMN_MARKER") = False Or _
       modServiceModule.IsNameExists(wbThis, "LI_ADD_ORG_HL_MARKER") = False Or _
       modServiceModule.IsNameExists(wbThis, "LI_ADD_FUEL_HL_COLUMN_MARKER") = False Or _
       modServiceModule.IsNameExists(wbThis, "LI_TECH_STATUS_COLUMN_MARKER") = False Or _
       modServiceModule.IsNameExists(wbThis, "ADD_ORG_LOST_INCOME") = False Then
      GoTo ErrHandler
    End If
  
  End If
  
  wbThis.Activate
  
  ' "Добавить организацию"
  If rngTarget.cells(1, 1).Value = "Добавить организацию" Then
  
    If modGlobalVars.BLN_APPLY_PLAN1X_ORG_DATA = True Then
    
      ' Добавление организации
      
      strORGRangeName = "ADD_ORG_LOST_INCOME"
      
    End If
    
    wsActiveSheet.Select
    
    If Len(strORGRangeName) > 0 Then
        
      modServiceModule.UNPROTECT_SHEET wsActiveSheet
    
      wsActiveSheet.Rows(lngRngTargetNRow & ":" & _
                         lngRngTargetNRow + wbThis.Names(strORGRangeName).RefersToRange.Rows.Count - 1).Insert Shift:=xlDown
           
           
      Application.CutCopyMode = False
      wsRanges.Range(strORGRangeName).Copy Destination:=wsActiveSheet.cells(lngRngTargetNRow, 1)
      Application.CutCopyMode = False

      lngDeleteColumnNumber = wsActiveSheet.Range("LI_DELETE_ORG_HL_COLUMN_MARKER").Column
      
      ' Note: Worksheet should be selected in MS Excel 2003
      
      rngTarget.Offset(0, -1).Select
      Selection.Offset(-1, 0).Select
        
      modServiceModule.RENUMBER_ADD_CELLS Selection
      
      
      wsActiveSheet.cells(lngRngTargetNRow, lngDeleteColumnNumber).Select
          
          
      wsActiveSheet.Select
      
      If modGlobalVars.BLN_APPLY_PLAN1X_ORG_DATA = True Then

        ' Автоматическое добавление

        Application.EnableEvents = False
        
        modServiceModule.UNPROTECT_SHEET wsActiveSheet
        
        wsActiveSheet.cells(lngRngTargetNRow, lngRngTargetNCol + 3).Value = modGlobalVars.STR_INN          ' ИНН
        wsActiveSheet.cells(lngRngTargetNRow, lngRngTargetNCol + 4).Value = modGlobalVars.STR_KPP          ' КПП
        wsActiveSheet.cells(lngRngTargetNRow, lngRngTargetNCol + 5).Value = modGlobalVars.STR_ORG          ' ОРГ

        wsActiveSheet.cells(lngRngTargetNRow, lngRngTargetNCol + 7).Value = modGlobalVars.STR_FIL          ' ФИЛ

        wsActiveSheet.cells(lngRngTargetNRow, lngRngTargetNCol + 9).Value = modGlobalVars.STR_VDET         ' ВПРОД

        wsActiveSheet.cells(lngRngTargetNRow, lngRngTargetNCol + 15).Value = "PLAN1X"                      ' SOURCE
        
      End If

    End If
    
    GoTo CleanUp
    
  End If
  
  
  ' "Удалить организацию" = "О"
  If rngTarget.cells(1, 1).Value = "О" And _
     rngTarget.Column = wbThis.Names("LI_DELETE_ORG_HL_COLUMN_MARKER").RefersToRange.Column Then
     
    ' Проверить источник организации и режим работы отчёта
    If InStr(1, wbThis.Names("TOPL_TEMPLATE_MODE").RefersToRange.cells(1, 1).Value, "регион", vbTextCompare) > 0 Then
    
      Set rngSOURCERange = wsActiveSheet.cells(lngRngTargetNRow, wsActiveSheet.Range("LI_EXCLUDE_ORG_REASON_HL_COLUMN_MARKER").Column).MergeArea
      Set rngNUMBERPLAN1XRange = wsActiveSheet.cells(lngRngTargetNRow, wsActiveSheet.Range("LI_PLAN1X_NUM_COLUMN_MARKER").Column).MergeArea
      
      modServiceModule.UNPROTECT_SHEET wsActiveSheet
            
      ' Условие удаления...
      If rngNUMBERPLAN1XRange.cells(1, 1).Value = "TOPL.QX" Or _
         rngNUMBERPLAN1XRange.cells(1, 1).Value = "PLAN1X" Then
      
        If rngTarget.Interior.ColorIndex = modDefines.colorRed Then
        
          ' Отмена удаления
          rngTarget.Interior.ColorIndex = modDefines.colorWhite
          rngSOURCERange.Interior.ColorIndex = modDefines.colorWhite
          rngSOURCERange.Locked = True
          rngSOURCERange.cells(1, 1).Value = vbNullString
        
          GoTo CleanUp
            
        Else
        
          ' Пометить на удаление
        
          If vbYes = MsgBox("Организация № '" & rngTarget.Offset(0, 1).MergeArea.cells(1, 1).Value & _
                            "' загружена по данным мониторинга " & _
                            IIf(rngNUMBERPLAN1XRange.cells(1, 1).Value = "PLAN1X", "SUMMARY.BALANCE.CALC.TARIFF.WARM.2014YEAR", "WARM.TOPL.QX.2014") & _
                            ". " & Chr(13) & _
                            "Для исключения организации из отчёта " & _
                            "необходимо указать комментарий причины удаления. " & _
                            "Продолжить?", vbYesNo + vbExclamation, modGlobals.STR_MSGBOX_WARNING_TITLE) Then
      
            rngTarget.Interior.ColorIndex = modDefines.colorRed
            rngSOURCERange.Interior.ColorIndex = modDefines.colorCyan
            rngSOURCERange.Locked = False
            rngSOURCERange.cells(1, 1).Value = "(помечена на удаление)"
            
            GoTo CleanUp
            
          Else
          
            GoTo CleanUp
          
          End If
      
        End If
      
      End If
      
    End If
    
  End If
  
  
  GoTo CleanUp

ErrHandler:
  GoTo CleanUp
CleanUp:
  If Not modGlobals.LNG_MODE = AutomaticMode Then
    ' Восстановить настройки ScreenUpdating, EnableEvents
    Application.ScreenUpdating = blnScreenUpdatingPreference
    Application.EnableEvents = blnEnableEventsPreference
    Application.CutCopyMode = False
    If Not wsActiveSheet Is Nothing Then
      modServiceModule.PROTECT_SHEET wsActiveSheet, True
    End If
    If Not wsActiveSheet Is Nothing And _
       lngRngTargetNRow > 0 And lngRngTargetNCol > 0 Then
      wsActiveSheet.cells(lngRngTargetNRow, lngRngTargetNCol).Select
    End If
  End If
End Sub

Attribute VB_Name = "modfrmHEATAdditionalOrgData"
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

Public Sub cmdOK_Click_Handler()

  On Error GoTo ErrHandler

  Dim strResult As String
  Dim strTariffResult As String
  Dim strFuelResult As String
  Dim strActivityResult As String
  Dim strTransmissionFromOrgResult As String
  Dim strSubsidiaryResult As String
  Dim strOtherIdentifierResult As String
  
  frmHEATAdditionalOrgData.lblStatusBar.caption = vbNullString
  
  If frmHEATAdditionalOrgData.chkTariff.Value = False And _
     frmHEATAdditionalOrgData.chkFuel.Value = False And _
     frmHEATAdditionalOrgData.chkActivity.Value = False And _
     frmHEATAdditionalOrgData.chkSubsidiary.Value = False And _
     frmHEATAdditionalOrgData.chkOtherIdentifier.Value = False Then
     
    frmHEATAdditionalOrgData.lblStatusBar.caption = "Не выбран ни один из признаков"
    
  Else
  
    strResult = vbNullString
    
    If frmHEATAdditionalOrgData.chkTariff.Value = True Then
      ' Тариф...
      If frmHEATAdditionalOrgData.optTF1.Value = False And _
         frmHEATAdditionalOrgData.optTF2.Value = False And _
         frmHEATAdditionalOrgData.optTF3.Value = False And _
         frmHEATAdditionalOrgData.optTF4.Value = False And _
         frmHEATAdditionalOrgData.optTF5.Value = False And _
         frmHEATAdditionalOrgData.optTF6.Value = False And _
         frmHEATAdditionalOrgData.optTF7.Value = False And _
         frmHEATAdditionalOrgData.optTF8.Value = False And _
         frmHEATAdditionalOrgData.optTF9.Value = False And _
         frmHEATAdditionalOrgData.optTF10.Value = False And _
         frmHEATAdditionalOrgData.optTF11.Value = False And _
         frmHEATAdditionalOrgData.optTF12.Value = False Then
        frmHEATAdditionalOrgData.lblStatusBar.caption = "Не выбран ни один из тарифов"
        frmHEATAdditionalOrgData.optTF1.SetFocus
        GoTo CleanUp
      Else
      
        strTariffResult = "Тариф: "
        
        If frmHEATAdditionalOrgData.optTF1.Value = True Then
          strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF1.caption
        End If
        
        If frmHEATAdditionalOrgData.optTF2.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF2.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF2.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.optTF3.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF3.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF3.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.optTF4.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF4.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF4.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.optTF5.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF5.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF5.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.optTF6.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF6.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF6.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.optTF7.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF7.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF7.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.optTF8.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF8.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF8.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.optTF9.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF9.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF9.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.optTF10.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF10.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF10.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.optTF11.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF11.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF11.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.optTF12.Value = True Then
          If strTariffResult = "Тариф: " Then
            strTariffResult = strTariffResult & frmHEATAdditionalOrgData.optTF12.caption
          Else
            strTariffResult = strTariffResult & "; " & frmHEATAdditionalOrgData.optTF12.caption
          End If
        End If
        
      End If
    End If
    
    If frmHEATAdditionalOrgData.chkFuel.Value = True Then
      ' Топливо...
      If frmHEATAdditionalOrgData.chkFuel1.Value = False And _
         frmHEATAdditionalOrgData.chkFuel2.Value = False And _
         frmHEATAdditionalOrgData.chkFuel3.Value = False And _
         frmHEATAdditionalOrgData.chkFuel4.Value = False And _
         frmHEATAdditionalOrgData.chkFuel5.Value = False And _
         frmHEATAdditionalOrgData.chkFuel6.Value = False And _
         frmHEATAdditionalOrgData.chkFuel7.Value = False And _
         frmHEATAdditionalOrgData.chkFuel8.Value = False And _
         frmHEATAdditionalOrgData.chkFuel9.Value = False Then
        frmHEATAdditionalOrgData.lblStatusBar.caption = "Не выбран ни один из видов используемого топлива"
        frmHEATAdditionalOrgData.chkFuel1.SetFocus
        GoTo CleanUp
      Else
      
        strFuelResult = "Топливо: "
        
        If frmHEATAdditionalOrgData.chkFuel1.Value = True Then
          strFuelResult = strFuelResult & frmHEATAdditionalOrgData.chkFuel1.caption
        End If
        
        If frmHEATAdditionalOrgData.chkFuel2.Value = True Then
          If strFuelResult = "Топливо: " Then
            strFuelResult = strFuelResult & frmHEATAdditionalOrgData.chkFuel2.caption
          Else
            strFuelResult = strFuelResult & "; " & frmHEATAdditionalOrgData.chkFuel2.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.chkFuel3.Value = True Then
          If strFuelResult = "Топливо: " Then
            strFuelResult = strFuelResult & frmHEATAdditionalOrgData.chkFuel3.caption
          Else
            strFuelResult = strFuelResult & "; " & frmHEATAdditionalOrgData.chkFuel3.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.chkFuel4.Value = True Then
          If strFuelResult = "Топливо: " Then
            strFuelResult = strFuelResult & frmHEATAdditionalOrgData.chkFuel4.caption
          Else
            strFuelResult = strFuelResult & "; " & frmHEATAdditionalOrgData.chkFuel4.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.chkFuel5.Value = True Then
          If strFuelResult = "Топливо: " Then
            strFuelResult = strFuelResult & frmHEATAdditionalOrgData.chkFuel5.caption
          Else
            strFuelResult = strFuelResult & "; " & frmHEATAdditionalOrgData.chkFuel5.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.chkFuel6.Value = True Then
          If strFuelResult = "Топливо: " Then
            strFuelResult = strFuelResult & frmHEATAdditionalOrgData.chkFuel6.caption
          Else
            strFuelResult = strFuelResult & "; " & frmHEATAdditionalOrgData.chkFuel6.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.chkFuel7.Value = True Then
          If strFuelResult = "Топливо: " Then
            strFuelResult = strFuelResult & frmHEATAdditionalOrgData.chkFuel7.caption
          Else
            strFuelResult = strFuelResult & "; " & frmHEATAdditionalOrgData.chkFuel7.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.chkFuel8.Value = True Then
          If strFuelResult = "Топливо: " Then
            strFuelResult = strFuelResult & frmHEATAdditionalOrgData.chkFuel8.caption
          Else
            strFuelResult = strFuelResult & "; " & frmHEATAdditionalOrgData.chkFuel8.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.chkFuel9.Value = True Then
          If strFuelResult = "Топливо: " Then
            strFuelResult = strFuelResult & frmHEATAdditionalOrgData.chkFuel9.caption
          Else
            strFuelResult = strFuelResult & "; " & frmHEATAdditionalOrgData.chkFuel9.caption
          End If
        End If
        
      End If
    End If
    
    If frmHEATAdditionalOrgData.chkActivity.Value = True Then
      ' Вид деятельности...
      If frmHEATAdditionalOrgData.chkActivity1.Value = False And _
         frmHEATAdditionalOrgData.chkActivity2.Value = False And _
         frmHEATAdditionalOrgData.chkActivity3.Value = False And _
         frmHEATAdditionalOrgData.chkActivity4.Value = False Then
        frmHEATAdditionalOrgData.lblStatusBar.caption = "Не выбран ни один из видов деятельности"
        frmHEATAdditionalOrgData.chkActivity1.SetFocus
        GoTo CleanUp
      Else
      
        strActivityResult = "Вид деятельности: "
        
        If frmHEATAdditionalOrgData.chkActivity1.Value = True Then
          strActivityResult = strActivityResult & frmHEATAdditionalOrgData.chkActivity1.caption
        End If
        
        If frmHEATAdditionalOrgData.chkActivity2.Value = True Then
          If strActivityResult = "Вид деятельности: " Then
            strActivityResult = strActivityResult & frmHEATAdditionalOrgData.chkActivity2.caption
          Else
            strActivityResult = strActivityResult & "; " & frmHEATAdditionalOrgData.chkActivity2.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.chkActivity3.Value = True Then
          If strActivityResult = "Вид деятельности: " Then
            strActivityResult = strActivityResult & frmHEATAdditionalOrgData.chkActivity3.caption
          Else
            strActivityResult = strActivityResult & "; " & frmHEATAdditionalOrgData.chkActivity3.caption
          End If
        End If
        
        If frmHEATAdditionalOrgData.chkActivity4.Value = True Then
          If strActivityResult = "Вид деятельности: " Then
            strActivityResult = strActivityResult & frmHEATAdditionalOrgData.chkActivity4.caption
          Else
            strActivityResult = strActivityResult & "; " & frmHEATAdditionalOrgData.chkActivity4.caption
          End If
        End If
        
      End If
    End If
    
    If frmHEATAdditionalOrgData.chkSubsidiary.Value = True Then
      ' Котельная (СЦТ)...
      If Len(frmHEATAdditionalOrgData.txtSubsidiary.Text) = 0 Then
        frmHEATAdditionalOrgData.lblStatusBar.caption = "Отсутвует информация в поле ""Котельная (СЦТ)"""
        frmHEATAdditionalOrgData.txtSubsidiary.SetFocus
        GoTo CleanUp
      Else
        strSubsidiaryResult = "Котельная (СЦТ): " & frmHEATAdditionalOrgData.txtSubsidiary.Text
      End If
    End If
    
    If frmHEATAdditionalOrgData.chkOtherIdentifier.Value = True Then
      ' Другое...
      If Len(frmHEATAdditionalOrgData.txtOtherIdentifier.Text) = 0 Then
        frmHEATAdditionalOrgData.lblStatusBar.caption = "Отсутвует информация в поле ""Другое"""
        frmHEATAdditionalOrgData.txtOtherIdentifier.SetFocus
        GoTo CleanUp
      Else
        strOtherIdentifierResult = "Другое: " & frmHEATAdditionalOrgData.txtOtherIdentifier.Text
      End If
    End If
    
    If Len(strTariffResult) > 0 Then
      strResult = strTariffResult
    End If
    
    If Len(strFuelResult) > 0 Then
      If Len(strResult) > 0 Then
        strResult = strResult & " :: " & strFuelResult
      Else
        strResult = strFuelResult
      End If
    End If
    
    If Len(strActivityResult) > 0 Then
      If Len(strResult) > 0 Then
        strResult = strResult & " :: " & strActivityResult
      Else
        strResult = strActivityResult
      End If
    End If
    
    If Len(strTransmissionFromOrgResult) > 0 Then
      If Len(strResult) > 0 Then
        strResult = strResult & " :: " & strTransmissionFromOrgResult
      Else
        strResult = strTransmissionFromOrgResult
      End If
    End If
    
    If Len(strSubsidiaryResult) > 0 Then
      If Len(strResult) > 0 Then
        strResult = strResult & " :: " & strSubsidiaryResult
      Else
        strResult = strSubsidiaryResult
      End If
    End If
    
    If Len(strOtherIdentifierResult) > 0 Then
      If Len(strResult) > 0 Then
        strResult = strResult & " :: " & strOtherIdentifierResult
      Else
        strResult = strOtherIdentifierResult
      End If
    End If
    
    strResult = IIf(Mid(strResult, 1, 4) = " :: ", Mid(strResult, 5), strResult)
    
    If Len(strResult) > 900 Then
    
      frmHEATAdditionalOrgData.lblStatusBar.caption = "Результат превышает 900 символов, " & _
                                                      "попытайтесь сократить содержимое текстовых полей"
    
    Else
    
      modServiceModule.UNPROTECT_SHEET ActiveSheet
      Selection.cells(1, 1).Value = strResult
      Selection.Interior.ColorIndex = modDefines.colorGreen
      modServiceModule.PROTECT_SHEET ActiveSheet, True
      
      Unload frmHEATAdditionalOrgData
    
    End If
    
  End If
  
…

Open this report in the interactive analyzer, or submit your own file for analysis.