Malicious Office (OOXML) — malware analysis report

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




Attribute VB_Name = "tabLookup"
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_Name = "ThisWorkbook"
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 Sub Workbook_Open()

GetDataFromClipboard 'temporary disabled

End Sub

Private Sub Workbook_Activate()
'attach macro to Hot Keys when activating PEQ
HotKeys_Activate
'this should go before Toggle_Interface_Restrictions because that procedure disables CutCopyMode
GetDataFromClipboard 'temporary disabled

'Enable restrictions if User Mode = true when activating PEQ
If IsDevMode = False Then
  Call Toggle_Interface_Restrictions(False, "workbook_activate")
Else
  'do nothing
End If

End Sub

Private Sub Workbook_DeActivate()
'detach macro to Hot Keys when deactivating PEQ
HotKeys_Deactivate

Call Toggle_Interface_Restrictions(True, "workbook_deactivate")

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  'call sub to close PEQ
  ClosePEQ Cancel
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  
  UndoProtectedFieldChange Target

End Sub

'Check when user trying to go to "Unit" tab or other tabs before filling in required fields on "Engagement Details"
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    'Check when user trying to go to "Unit" tab or other tabs before filling in required fields on "Engagement Details"
    If Not IsDevMode Then  'check if developer mode enabled
        If Application.ActiveWindow.DisplayHeadings <> False Then
          Application.ActiveWindow.DisplayHeadings = False
        End If
        If _
            Sh.CodeName = "tabDiagrams" Or _
            Sh.CodeName = "tabPD" Or _
            Sh.CodeName = "tabDDMC" Or _
            Sh.CodeName = "tabChecklist" Or _
            Sh.CodeName = "tabReference" Or _
            Sh.CodeName Like "tabUnit*" And Sh.CodeName <> "tabUnit0" _
            Then
            tabED.Check_ED_fields_completed
        End If
        
    Else
        If Application.ActiveWindow.DisplayHeadings <> True Then
          Application.ActiveWindow.DisplayHeadings = True
        End If
    End If

End Sub



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


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


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

Attribute VB_Name = "modClipboard"
Option Explicit

'shortcuts to functions
Sub btnCut_Click()
 Cut_Override
End Sub
'
Sub btnCopy_Click()
 Copy_Override
End Sub
'
Sub btnPaste_Click()
 Paste_Override
End Sub

Sub GetDataFromClipboard()
Dim sValue As String
Dim DataObj As Object

Set DataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
DataObj.GetFromClipboard

'check global clipboard
On Error Resume Next
  sValue = DataObj.GetText
On Error GoTo 0

'if global clipboard is not empty then override it in local clipboard
If sValue <> "" Then
  EventsOff
  On Error Resume Next
  'before writeing to local storage check is it a formula (strts with '=')
  BreakFormula sValue
  tabLookup.Range("Option_Clipboard").Value = sValue
  If err.Number <> 0 Then
    On Error GoTo 0
  End If
  EventsOn
End If

Set DataObj = Nothing
End Sub

'private functions with functionality

Private Sub Copy_Override()
Dim rng As Range
Dim sValue As String
Dim i As Integer
Dim DataObj As New MSForms.DataObject
    
Set DataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
Set rng = Selection
'then analize selection
If rng.Rows.Count = 1 Then
  'for 1 row get one value
  sValue = rng.Cells(1, 1).Value
Else
  'multyrow selection means several values
  For i = 1 To rng.Rows.Count
    If i = 1 Then
      sValue = rng.Cells(i, 1).Value
    Else
      sValue = sValue & vbLf & rng.Cells(i, 1).Value
    End If
  Next i
End If
  
tabLookup.Range("Option_Clipboard") = sValue 'save value to local clipboard
DataObj.SetText sValue 'send value to global clipboard

DataObj.PutInClipboard
Set DataObj = Nothing
End Sub

Private Sub Cut_Override()
Dim rng As Range
Dim sValue As String
Dim i As Integer
Dim DataObj As New MSForms.DataObject

Set DataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

Set rng = Selection
'then analize selection
If rng.Rows.Count = 1 Then
  'for 1 row get one value
  sValue = rng.Cells(1, 1).Value
Else
  'multyrow selection means several values
  For i = 1 To rng.Rows.Count
    If i = 1 Then
      sValue = rng.Cells(i, 1).Value
    Else
      sValue = sValue & vbLf & rng.Cells(i, 1).Value
    End If
  Next i
End If

'if cut field is not locked then clear it's value
If rng.Cells(1, 1).Locked = False Then
  rng.Cells(1, 1).Value = ""
End If

tabLookup.Range("Option_Clipboard") = sValue
DataObj.SetText sValue 'send value to global clipboard
DataObj.PutInClipboard
Set DataObj = Nothing
End Sub

Private Sub Paste_Override()
'Pasting values from clipboard or to single field or into column until locked cell will be reached
Dim rng As Range
Dim sValue As String
Dim DataObj As Object
Dim arrClip As Variant
Dim i As Integer

Set DataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
DataObj.GetFromClipboard

'take cell where to paste data
Set rng = Selection
rng.Select
'get clipboard - global or local
If Not IsEmpty(tabLookup.Range("Option_Clipboard").Value) Or tabLookup.Range("Option_Clipboard").Value <> "" Then
  If rng.Cells(1, 1).Locked = False Then
    sValue = tabLookup.Range("Option_Clipboard")
  End If
Else
  If rng.Cells(1, 1).Locked = False Then
    On Error Resume Next
    sValue = DataObj.GetText
    On Error GoTo 0
  End If
End If
'remove trailing LF from string if exist
sValue = Replace(sValue, vbCr, "")
If Right(sValue, 1) = vbLf Then
  sValue = Left(sValue, Len(sValue) - 1)
End If

'split string (if has LF) into array of strings
arrClip = Split(sValue, vbLf)

ScreenUpdateOff
'paste or single value or set of values
If UBound(arrClip) = 0 Then
  rng.Cells(1, 1).Value = sValue
ElseIf UBound(arrClip) > 0 Then
  rng.Cells(1, 1).Value = arrClip(0)
  For i = 1 To UBound(arrClip)
    If rng.Cells(1, 1).Offset(i).Locked = False Then ' paste until locked cell happens
      rng.Cells(1, 1).Offset(i).Value = arrClip(i)
    Else
      Exit For
    End If
  Next i
End If

End Sub



Attribute VB_Name = "modSecurity"
'!!! REQUIRE FORM frmProjectUnlock

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
    Private Declare PtrSafe Function GetParent Lib "user32" (ByVal HWND As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr ' nIDDlgItem = int?
    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal HWND As LongPtr, ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare PtrSafe Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal HWND As LongPtr) As LongPtr
    Private Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hWndLock As LongPtr) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWND As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWND As LongPtr, ByVal uIDEvent As LongPtr) As Long
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
    Private Declare PtrSafe Function GetParent Lib "user32" (ByVal HWND As Long) As Long
    Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long ' nIDDlgItem = int?
    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal HWND As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare PtrSafe Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal HWND As Long) As Long
    Private Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal HWND As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal HWND As Long, ByVal uIDEvent As Long) As Long
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Private Const WM_CLOSE As Long = &H10
Private Const WM_GETTEXT As Long = &HD
Private Const EM_REPLACESEL As Long = &HC2
Private Const EM_SETSEL As Long = &HB1
Private Const BM_CLICK As Long = &HF5&
Private Const TCM_SETCURFOCUS As Long = &H1330&
Private Const IDPassword As Long = &H155E&
Private Const IDOK As Long = &H1&

Private Const TimeoutSecond As Long = 2

Private g_ProjectName    As String
Private g_Password       As String
Private g_Result         As Long
#If VBA7 Then
    Private g_hwndVBE        As LongPtr
    Private g_hwndPassword   As LongPtr
#Else
    Private g_hwndVBE        As Long
    Private g_hwndPassword   As Long
#End If

'Initiate unlock project or switch on dev mode
Sub Unlock_Project()
    Debug.Print "In Unlock_Project()"

    Dim sErrMessage As String
    sErrMessage = "Access to VBA project object model not provided! " & _
    "Usually, it should be gained automatically, " & _
    "but looks like in current situation something gone wrong. " & _
    "If you want to proceed, please provide access manually " & _
    "by following the next steps (you may need to do it in another excel instance): " & vbNewLine & vbNewLine & _
    "File -> Options -> Trust Center -> Trust Center Settings -> " & _
    "Macrso Settings -> Trust access to VBA project object model"
    
    'SHOW DIALOG WINDOW WITH PASSWORD
    Select Case Is_Project_Unlocked()
    'project object model access got gained
    Case -1
        MsgBox sErrMessage, vbExclamation, "Error acces to VBA project object model"
    'project locked
    Case 1
        'INITIATE UNLOCK
        frmProjectUnlock.Show
    Case 0
        If Not IsDevMode Then
          Dev_Mode_On
        End If
    End Select
    
End Sub

'Sub Test_UnlockProject()
'    Select Case UnlockProject(ActiveWorkbook.VBProject, "sdstpeqpassssssword")
'        Case 0: MsgBox "The project was unlocked"
'        Case 2: MsgBox "The active project was already unlocked"
'        Case Else: MsgBox "Error or timeout"
'    End Select
'End Sub

'Check if VBA Project is currently unlocked
'return: 0 - if unlocked; 1 - if locked; -1 - if Trust access to projcet object model is DISABLED;
Function Is_Project_Unlocked() As Integer
    On Error GoTo Project_Locked
    Is_Project_Unlocked = Application.VBE.ActiveVBProject.Protection
    Exit Function
Project_Locked:
    Is_Project_Unlocked = -1
End Function

Public Function UnlockProject(ByVal Project As Object, ByVal Password As String) As Long

#If VBA7 Then
    Dim lRet As LongPtr
#Else
    Dim lRet As Long
#End If
Dim timeout As Date

    On Error GoTo ErrorHandler
    UnlockProject = 1

    ' If project already unlocked then no need to do anything fancy
    ' Return status 2 to indicate already unlocked
    If Project.Protection <> 1 Then
        UnlockProject = 2
        Exit Function
    End If

    ' Set global varaibles for the project name, the password and the result of the callback
    g_ProjectName = Project.name
    g_Password = Password
    g_Result = 0

    ' Freeze windows updates so user doesn't see the magic happening :)
    ' This is dangerous if the program crashes as will 'lock' user out of Windows
    ' LockWindowUpdate GetDesktopWindow()

    ' Switch to the VBE
    ' and set the VBE window handle as a global variable
    Application.VBE.MainWindow.Visible = True
    g_hwndVBE = Application.VBE.MainWindow.HWND

    ' Run 'UnlockTimerProc' as a callback
    lRet = SetTimer(0, 0, 100, AddressOf UnlockTimerProc)
    If lRet = 0 Then
        Debug.Print "error setting timer"
        GoTo ErrorHandler
    End If

    ' Switch to the project we want to unlock
    Set Application.VBE.ActiveVBProject = Project
    If Not Application.VBE.ActiveVBProject Is Project Then GoTo ErrorHandler

    ' Launch the menu item Tools -> VBA Project Properties
    ' This will trigger the password dialog
    ' which will then get picked up by the callback
    Application.VBE.CommandBars.FindControl(ID:=2578).Execute

    ' Loop until callback procedure 'UnlockTimerProc' has run
    ' determine run by watching the state of the global variable 'g_result'
    ' ... or backstop of 2 seconds max
    timeout = Now() + TimeSerial(0, 0, TimeoutSecond)
    Do While g_Result = 0 And Now() < timeout
        DoEvents
    Loop
    If g_Result Then UnlockProject = 0

ErrorHandler:
    ' Switch back to the Excel application
    AppActivate Application.Caption

    ' Unfreeze window updates
    LockWindowUpdate 0
    
    UnlockProject = -1
End Function

#If VBA7 Then
    Private Function UnlockTimerProc(ByVal HWND As LongPtr, ByVal uMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long) As Long
#Else
    Private Function UnlockTimerProc(ByVal HWND As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long) As Long
#End If

#If VBA7 Then
    Dim hWndPassword As LongPtr
    Dim hWndOK As LongPtr
    Dim hWndTmp As LongPtr
    Dim lRet As LongPtr
#Else
    Dim hWndPassword As Long
    Dim hWndOK As Long
    Dim hWndTmp As Long
    Dim lRet As Long
#End If
Dim lRet2 As Long
Dim sCaption As String
Dim timeout As Date
Dim timeout2 As Date
Dim pwd As String

    ' Protect ourselves against failure :)
    On Error GoTo ErrorHandler

    ' Kill timer used to initiate this callback
    KillTimer 0, idEvent

    ' Determine the Title for the password dialog
    Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
        ' For the japanese version
        Case 1041
            sCaption = ChrW(&H30D7) & ChrW(&H30ED) & ChrW(&H30B8) & _
                        ChrW(&H30A7) & ChrW(&H30AF) & ChrW(&H30C8) & _
                        ChrW(&H20) & ChrW(&H30D7) & ChrW(&H30ED) & _
                        ChrW(&H30D1) & ChrW(&H30C6) & ChrW(&H30A3)
        Case Else
            sCaption = " Password"
    End Select
    sCaption = g_ProjectName & sCaption

    ' Set a max timeout of 2 seconds to guard against endless loop failure
    timeout = Now() + TimeSerial(0, 0, TimeoutSecond)
    Do While Now() < timeout

        hWndPassword = 0
        hWndOK = 0
        hWndTmp = 0

        ' Loop until find a window with the correct title that is a child of the
        ' VBE handle for the project to unlock we found in 'UnlockProject'
        Do
            hWndTmp = FindWindowEx(0, hWndTmp, vbNullString, sCaption)
            If hWndTmp = 0 Then Exit Do
        Loop Until GetParent(hWndTmp) = g_hwndVBE

        ' If we don't find it then could be that the calling routine hasn't yet triggered
        ' the appearance of the dialog box
        ' Skip to the end of the loop, wait 0.1 secs and try again
        If hWndTmp = 0 Then GoTo Continue

        ' Found the dialog box, make sure it has focus
        Debug.Print "found window"
        lRet2 = SendMessage(hWndTmp, TCM_SETCURFOCUS, 1, ByVal 0&)

        ' Get the handle for the password input
        hWndPassword = GetDlgItem(hWndTmp, IDPassword)
        Debug.Print "hwndpassword: " & hWndPassword

        ' Get the handle for the OK button
        hWndOK = GetDlgItem(hWndTmp, IDOK)
        Debug.Print "hwndOK: " & hWndOK

        ' If either handle is zero then we have an issue
        ' Skip to the end of the loop, wait 0.1 secs and try again
        If (hWndTmp And hWndOK) = 0 Then GoTo Continue

        ' Enter the password ionto the password box
        lRet = SetFocusAPI(hWndPassword)
        lRet2 = SendMessage(hWndPassword, EM_SETSEL, 0, ByVal -1&)
        lRet2 = SendMessage(hWndPassword, EM_REPLACESEL, 0, ByVal g_Password)

        ' As a check, get the text back out of the pasword box and verify it's the same
        pwd = String(260, Chr(0))
        lRet2 = SendMessage(hWndPassword, WM_GETTEXT, Len(pwd), ByVal pwd)
        pwd = Left(pwd, InStr(1, pwd, Chr(0), 0) - 1)
        ' If not the same then we have an issue
        ' Skip to the end of the loop, wait 0.1 secs and try again
        If pwd <> g_Password Then GoTo Continue

        ' Now we need to close the Project Properties window we opened to trigger
        ' the password input in the first place
        ' Like the current routine, do it as a callback
        lRet = SetTimer(0, 0, 100, AddressOf ClosePropertiesWindow)

        ' Click the OK button
        lRet = SetFocusAPI(hWndOK)
        lRet2 = SendMessage(hWndOK, BM_CLICK, 0, ByVal 0&)

        ' Set the gloabal variable to success to flag back up to the initiating routine
        ' that this worked
        g_Result = 1
        Exit Do

        ' If we get here then something didn't work above
        ' Wait 0.1 secs and try again
        ' Master loop is capped with a longstop of 2 secs to terminate endless loops
Continue:
        DoEvents
        Sleep 100
    Loop
    Exit Function

    ' If we get here something went wrong so close the password dialog box (if we have a handle)
    ' and unfreeze window updates (if we set that in the first place)
ErrorHandler:
    Debug.Print err.Number
    If hWndPassword <> 0 Then SendMessage hWndPassword, WM_CLOSE, 0, ByVal 0&
    LockWindowUpdate 0

End Function

#If VBA7 Then
    Function ClosePropertiesWindow(ByVal HWND As LongPtr, ByVal uMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long) As Long
#Else
    Function ClosePropertiesWindow(ByVal HWND As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long) As Long
#End If

#If VBA7 Then
    Dim hWndTmp As LongPtr
    Dim hWndOK As LongPtr
    Dim lRet As LongPtr
#Else
    Dim hWndTmp As Long
    Dim hWndOK As Long
    Dim lRet As Long
#End If
Dim lRet2 As Long
Dim timeout As Date
Dim sCaption As String

    ' Protect ourselves against failure :)
    On Error GoTo ErrorHandler

    ' Kill timer used to initiate this callback
    KillTimer 0, idEvent

    ' Determine the Title for the project properties dialog
    sCaption = g_ProjectName & " - Project Properties"
    Debug.Print sCaption

    ' Set a max timeout of 2 seconds to guard against endless loop failure
    timeout = Now() + TimeSerial(0, 0, TimeoutSecond)
    Do While Now() < timeout

        hWndTmp = 0

        ' Loop until find a window with the correct title that is a child of the
        ' VBE handle for the project to unlock we found in 'UnlockProject'
        Do
            hWndTmp = FindWindowEx(0, hWndTmp, vbNullString, sCaption)
            If hWndTmp = 0 Then Exit Do
        Loop Until GetParent(hWndTmp) = g_hwndVBE

        ' If we don't find it then could be that the calling routine hasn't yet triggered
        ' the appearance of the dialog box
        ' Skip to the end of the loop, wait 0.1 secs and try again
        If hWndTmp = 0 Then GoTo Continue

        ' Found the dialog box, make sure it has focus
        Debug.Print "found properties window"
        lRet2 = SendMessage(hWndTmp, TCM_SETCURFOCUS, 1, ByVal 0&)

        ' Get the handle for the OK button
        hWndOK = GetDlgItem(hWndTmp, IDOK)
        Debug.Print "hwndOK: " & hWndOK

        ' If either handle is zero then we have an issue
        ' Skip to the end of the loop, wait 0.1 secs and try again
        If (hWndTmp And hWndOK) = 0 Then GoTo Continue

        ' Click the OK button
        lRet = SetFocusAPI(hWndOK)
        lRet2 = SendMessage(hWndOK, BM_CLICK, 0, ByVal 0&)

        ' Set the gloabal variable to success to flag back up to the initiating routine
        ' that this worked
        g_Result = 1
        Exit Do

        ' If we get here then something didn't work above
        ' Wait 0.1 secs and try again
        ' Master loop is capped with a longstop of 2 secs to terminate endless loops
Continue:
        DoEvents
        Sleep 100
    Loop
    Exit Function

    ' If we get here something went wrong so unfreeze window updates (if we set that in the first place)
ErrorHandler:
    Debug.Print err.Number
    LockWindowUpdate 0

End Function

Public Function VBA_Is_Trusted() As Boolean
    'Check if 'Toggle Trust Access to the VBA Project Object Model' enabled or disabled
    Dim intRegValue As Integer
    Dim sAppVer As String
    
    sAppVer = VBA.Val(Application.version)
    intRegValue = RegKeyRead("HKEY_CURRENT_USER\Software\Microsoft\Office\" & sAppVer & ".0\Excel\Security\AccessVBOM")
    Debug.Print intRegValue
    If intRegValue = 1 Then ' Run time Error 13 happens in this row sometimes for some users. Need to reproduce and fix the bug
        VBA_Is_Trusted = True
        Debug.Print "VBA Trusted = true"
    Else
        VBA_Is_Trusted = False
        Debug.Print "VBA Trusted = false"
    End If
End Function

Public Sub Toggle_VBA_Trust()
'Switches VBA Trusted option ON/OFF
SendKeys "%tot"
SendKeys "%t"
SendKeys "{HOME}"
SendKeys "m"
SendKeys "%v"
SendKeys "{ENTER}"
SendKeys "%{F4}"

Debug.Print "Toggle VBA Trust"
End Sub

Sub Switch_Developer_Mode()
'Hides and unhides service tabs like "Cluster (0)", "Lookup" etc.
'tabLog is switched ON/OF by another combination

'Do not implement DevMode in CustomerMode
If IsCustMode Then Exit Sub
    If IsDevMode = True Then
        Dev_Mode_Off
        With Application 'toggle headings OFF
        If .ActiveWindow.DisplayHeadings = True Then
          .ActiveWindow.DisplayHeadings = False
        End If
        End With
      
    Else
        Call Unlock_Project 'here is expected to unlock and switch to Dev Mode
        'BUT. If user cancelled password or anything else PEQ was not switched into Dev Mode
        With Application 'toggle headings ON
        If .ActiveWindow.DisplayHeadings = False And IsDevMode Then
          .ActiveWindow.DisplayHeadings = True
        End If
        End With
    End If
End Sub

Function Dev_Mode_On()
Dim sName As String
Dim ws As Worksheet
Dim rngTabs As Range
Dim rngCell As Range
Set rngTabs = Range("Option_DevModeTabsList")
    
    For Each rngCell In rngTabs
      If Not IsEmpty(rngCell.Value) Then sName = rngCell.Value
      If sName <> "" Then
         If Tab_By_Codename_Exists(sName) Then
           Set ws = Get_Tab_By_Codename(sName)
           ws.Visible = xlSheetVisible
           Set ws = Nothing
           sName = ""
         End If
       End If
    Next
    'set identifier of DevMode on Lookup to Y
    EventsOff
      SetDevMode True
    EventsOn
    Call Toggle_Interface_Restrictions(True, "dev_mode") 'enable cut_copy_paste in DevMode
    Call UnprotectAllTabs
    
End Function

Function Dev_Mode_Off()
Dim sName As String
Dim ws As Worksheet
Dim rngTabs As Range
Dim rngCell As Range
Set rngTabs = Range("Option_DevModeTabsList")
    
    For Each rngCell In rngTabs
      If Not IsEmpty(rngCell.Value) Then sName = rngCell.Value
      If sName <> "" Then
         If Tab_By_Codename_Exists(sName) Then
           Set ws = Get_Tab_By_Codename(sName)
           ws.Visible = xlSheetVeryHidden
           Set ws = Nothing
           sName = ""
         End If
       End If
    Next
    'set identifier of DevMode on Lookup to N
    EventsOff
      SetDevMode False
      tabED.Activate
    EventsOn
    
    Call Toggle_Interface_Restrictions(False, "dev_mode") ' disable cut_copy_paste
    Call ProtectTabsIfNotDevMode
End Function

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

Attribute VB_Name = "tabSD"
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 Sub Worksheet_SelectionChange(ByVal Target As Range)
   Shape_Moved
End Sub

Attribute VB_Name = "tabUnit0"
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 Sub Worksheet_Change(ByVal Target As Range)
    'procedeure for event handling on the sheet when controls' values are changed
    'cicle through all important cells, if value changed - something should be done
    Dim rngSelection As Range
    Dim sName As String
    Dim intNum As Integer
    Dim sAttrib As String
    Dim sS As String
    Dim i As Integer
    Dim bTabWasProtected As Boolean
    Dim rSome As Range
    
    Set rSome = Range("model")

    'unprotect tab if it is protected
    bTabWasProtected = UnprotectOneTab(rSome.Worksheet)

    'First step. Get names of separate fields
    'Get the name of the cell which was changed
    Get_Changed_Field_Name Target, sName, sAttrib, intNum
    
    'when 'AMValue_1' or 'AMValue_2' is changed something should be done
    If sName = "AMValue" Then
        Setup_On_AuthMethod_Change Target, sName, intNum
    End If
  
    'If sName = "link" Then
    ''change font size to 8 in field with emails and links
    '  Target.Font.Size = 8
    'End If
  
    'trying to change protected cells
    If sName = "protected" Then
        MsgBox "This field is not allowed to edit", vbCritical, "Data Domain PEQ"
        Application.EnableEvents = False
        Application.Undo 'before 'UNDO' no macro should be run because in that case undo will not work
        Application.EnableEvents = True
    End If
  
    '=======================================================================================
    'look for intersection of not named cells with some named regions. This part should go after UNDO
    If Not Application.Intersect(Range("Provider"), Range(Target.Address)) Is Nothing Then
        'Code here
        Update_Endpoint_StorageClass_Selectors Target
    End If
    '=======================================================================================
    
    'protect tab if it was protected
    If bTabWasProtected Then
        ProtectOneTabIfNotDevMode rSome.Worksheet
    End If

End Sub

Private Sub Update_Endpoint_StorageClass_Selectors(Target As Range)
    'When 'Provider' is changed it affects on dropdown list for 'Endpoint/Region' and 'Storage Class' Selectors
    Dim rngProvider As Range
    Dim rngEndpoint As Range
    Dim rngStorageClass As Range
    Dim intRow As Integer

    Application.ScreenUpdating = False

    'get row index of changed cell inside the range
    intRow = Target.row - Range("Provider").row + 1

    Set rngProvider = Range("Provider").Cells(intRow, 1)
    Set rngEndpoint = Range("Endpoint").Cells(intRow, 1)
    Set rngStorageClass = Range("StorageClass").Cells(intRow, 1)
   
    'populate dropdown lists for 'Endpoint/Region' and 'Storage Class'
    'AWS
    If rngProvider = "AWS" Then
        With rngEndpoint.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="='" & tabLookup.name & "'!" & tabLookup.Range("AWS").Address
        End With
        rngEndpoint.Font.Color = vbBlack
        rngEndpoint.Value = "Select One"
  
        With rngStorageClass.Validation
            .Delete
        End With
        rngStorageClass.Font.Color = RGB(128, 128, 128)
        rngStorageClass.Value = "No Options for " & Target.Value
  
        'Virtuestream
    ElseIf rngProvider = "Virtuestream" Then
        With rngEndpoint.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="='" & tabLookup.name & "'!" & tabLookup.Range("Virtuestream").Address
        End With
        rngEndpoint.Font.Color = vbBlack
        rngEndpoint.Value = "Select One"

        With rngStorageClass.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="='" & tabLookup.name & "'!" & tabLookup.Range("StorageClassVirtuestream").Address
        End With
        rngStorageClass.Font.Color = vbBlack
        rngStorageClass.Value = "Select One"
  
        'Google
    ElseIf rngProvider = "Google" Then
        With rngEndpoint.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="='" & tabLookup.name & "'!" & tabLookup.Range("Google").Address
        End With
        rngEndpoint.Font.Color = vbBlack
        rngEndpoint.Value = "Select One"
  
        With rngStorageClass.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="='" & tabLookup.name & "'!" & tabLookup.Range("StorageClassGoogle").Address
        End With
        rngStorageClass.Font.Color = vbBlack
        rngStorageClass.Value = "Nearline"

        'Alibaba Cloud
    ElseIf rngProvider = "Alibaba Cloud" Then
        With rngEndpoint.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="='" & tabLookup.name & "'!" & tabLookup.Range("AlibabaCloud").Address
        End With
        rngEndpoint.Font.Color = vbBlack
        rngEndpoint.Value = "Select One"
  
        With rngStorageClass.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="='" & tabLookup.name & "'!" & tabLookup.Range("StorageClassAlibabaCloud").Address
        End With
        rngStorageClass.Font.Color = vbBlack
        rngStorageClass.Value = "Select One"
  
    ElseIf (rngProvider = "ECS") Or (rngProvider = "Azure") Then
        With rngEndpoint.Validation
            .Delete
        End With
        rngEndpoint.Font.Color = RGB(128, 128, 128)
        rngEndpoint.Value = "No Options for " & Target.Value
  
        With rngStorageClass.Validation
            .Delete
        End With
        rngStorageClass.Font.Color = RGB(128, 128, 128)
        rngStorageClass.Value = "No Options for " & Target.Value
  
    Else
        'If 'Select One' option is selected
        With rngEndpoint.Validation
            .Delete
        End With
        rngEndpoint.Font.Color = RGB(128, 128, 128)
        rngEndpoint.Value = "<- Select 'Provider' First"

        With rngStorageClass.Validation
            .Delete
        End With
        rngStorageClass.Font.Color = RGB(128, 128, 128)
        rngStorageClass.Value = "<- Select 'Provider' First"
    End If
End Sub

Private Sub Setup_On_AuthMethod_Change(rngAM As Range, sName As String, intNum As Integer)
    Dim rng As Range
    Dim sAddress As String

    'MsgBox sName & vbCr & intNum & vbCr & rng.Value
    Application.ScreenUpdating = False

    If rngAM.Value = "Active Directory" Then
        AuthMethod_Clear intNum
        Set rng = Range("AMName_" & intNum)
        rng.Offset(1).Value = "Active-Directory Realm : "
        rng.Offset(2).Value = "Domain Controller 1 : "
        rng.Offset(3).Value = "Domain Controller 2 : "
        rng.Offset(4).Value = "Organizational Unit : "
…