Sub Auto_Open()
Application.OnTime Now() + TimeSerial(0, 0, 2), "changetheme"
End Sub

Sub dark_theme()
CreateObject("WScript.Shell").RegWrite "HKCU\Software\Microsoft\Office\14.0\Common\Theme", 3, "REG_DWORD"
CreateObject("WScript.Shell").Run "excel.exe /e """ & psDocName & """"
Application.Quit
End Sub

Sub white_theme()
CreateObject("WScript.Shell").RegWrite "HKCU\Software\Microsoft\Office\14.0\Common\Theme", 2, "REG_DWORD"
CreateObject("WScript.Shell").Run "excel.exe /e """ & psDocName & """"
Application.Quit
End Sub

Sub changetheme()
Application.ScreenUpdating = False
psMyDir = ActiveWorkbook.Path
ptwbn = ActiveWorkbook.Name
psDocName = psMyDir & Application.PathSeparator & ptwbn
If InStr(1, LCase(ActiveWorkbook.ActiveSheet.Cells(3, 6)), "№1") > 0 Then aiaw = 1:
If InStr(1, LCase(ActiveWorkbook.ActiveSheet.Cells(3, 7)), "№1") > 0 Then aiaw = 1:
If InStr(1, LCase(ActiveWorkbook.ActiveSheet.Cells(3, 6)), "№2") > 0 Then aiad = 1: MsgBox "      НЕТ       ", vbCritical
If InStr(1, LCase(ActiveWorkbook.ActiveSheet.Cells(3, 7)), "№2") > 0 Then aiad = 1: MsgBox "      НЕТ       ", vbCritical
If aiaw = 0 And aiad = 0 Then
     MsgBox "условия не определены", vbExclamation
        If CreateObject("WScript.Shell").RegRead("HKCU\Software\Microsoft\Office\14.0\Common\Theme") = 2 Then GoTo e1
        ActiveWorkbook.Close: white_theme
End If
If aiad = 1 Then
                If CreateObject("WScript.Shell").RegRead("HKCU\Software\Microsoft\Office\14.0\Common\Theme") = 3 Then GoTo e1 ' CreateObject("WScript.Shell").RegWrite "HKCU\Software\Microsoft\Office\12.0\Common\Theme", 3, "REG_DWORD"
                ActiveWorkbook.Close
                dark_theme
Else
    If aiaw = 1 Then
        If CreateObject("WScript.Shell").RegRead("HKCU\Software\Microsoft\Office\14.0\Common\Theme") = 2 Then GoTo e1 ' CreateObject("WScript.Shell").RegWrite "HKCU\Software\Microsoft\Office\12.0\Common\Theme", 3, "REG_DWORD"
            ActiveWorkbook.Close
            white_theme
    End If
End If
e1:
Application.ScreenUpdating = True
End Sub