With Sheets("a2")
.Select
With .Range(Cells(1, 1), Cells(5, 5))
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = -0.149998474074526
End With
End With

With Sheets("a2")
With .Range("A1:B5")
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = -0.149998474074526
End With
End With

With Sheets("a2")
With .Range(Cells(1, 1), Cells(5, 5))
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = -0.149998474074526
End With
End With

Sub cd1()
'st = "a1_8_9_10": Call cd1: Dim s333 As Object: Set s333 = s1:Set s1 = Nothing
Call sp
i100 = CInt(stri(1))
j100 = CInt(stri(2))
Do While Sheets(stri(0)).Cells(i100, j100).Value <> ""
i100 = i100 + 1
Loop
i100 = i100 - 1
'Debug.Print i100
Set s1 = CreateObject("Scripting.Dictionary")
For i = CInt(stri(1)) To i100
      key11 = CStr(Sheets(stri(0)).Cells(i, CInt(stri(2))).Value)
      item11 = CStr(Sheets(stri(0)).Cells(i, CInt(stri(3))).Value)
      'Debug.Print key11, Item11
      If Not s1.exists(key11) Then s1.Add key11, item11
Next i
End Sub

Sub knopko()
Call ofb
st = "a1_7_8": Call co
st = "a1_" & lr & "_8": Call oval
val = val + 1
st = "a1_" & lr + 1 & "_8_" & val: Call ival
st = "a1_" & lr + 1 & "_8_" & lr + 1 & "_8": Call tu
st = "a1_" & lr + 1 & "_9_" & lr + 1 & "_12": Call tc
st = "a1_" & lr + 1 & "_10_" & lr + 1 & "_10": Call slil
Call ofe
End Sub

Global di As Object
Sub test4()
di = "ssn": Call sd
End Sub
Sub sd()
Set di = CreateObject("Scripting.Dictionary")
End Sub

Declare Function waveOutSetVolume Lib "winmm.dll" (ByVal uDeviceID As Integer, ByVal dwVolume As Integer) As Integer
retval = waveOutSetVolume(0, &HFFFF)

Declare Function waveoutSetVolume Lib "mmsystem.dll" (ByVal wDeviceID As Integer, ByVal dwVolumeRight As Integer, ByVal dwVolumeLeft As Integer) As Integer
   
   Const SND_ASYNC = &H1
   Const SND_NODEFAULT = &H2
   Dim CurrentVolLeft As Long
   Dim CurrentVolRight As Long

   Dim x As Integer
   CurrentVolLeft = CurrentVolLeft + &H1000&
   If CurrentVolLeft > &HFFFF& Then CurrentVolLeft = &HFFFF&
   x = waveoutSetVolume(0, CInt("&H" + Hex$(CurrentVolRight)), CInt("&H" + Hex$(CurrentVolLeft)))

'запускаем exe
p = "C:\Users\XXX\Desktop"
    Call Shell(p & "\XXX.exe")
    Application.Wait (Now + TimeValue("0:00:05"))
        
'активируем окно exe
    AppActivate ("XXX")
'нажимаем TAB, Enter
    SendKeys "{TAB 1}", True
    Debug.Print "tab"
    Application.Wait (Now + TimeValue("0:00:05"))
    
    SendKeys "{Enter 1}", True
    Debug.Print "enter"
    Application.Wait (Now + TimeValue("0:00:05"))
'курсор на окне "обзор" вбиваем в него путь к файлу
    SendKeys p & "\XXX.xlsx", True
    Application.Wait (Now + TimeValue("0:00:05"))
 
'нажимаем TAB, Enter
    SendKeys "{Enter 1}", True
    Debug.Print "enter"
    Application.Wait (Now + TimeValue("0:00:05"))
    
    AppActivate ("XXX")
    Application.Wait (Now + TimeValue("0:00:05"))
    
    SendKeys "{Enter 1}", True
    Debug.Print "enter"
    Application.Wait (Now + TimeValue("0:00:05"))
    
    SendKeys "{TAB 1}", True
    Debug.Print "tab"
    Application.Wait (Now + TimeValue("0:00:05"))
    
    SendKeys "{Enter 1}", True
    Debug.Print "enter"
    Application.Wait (Now + TimeValue("0:00:05"))

 Set oOutlook = GetObject(, "outlook.Application")
  
        Set oNamespace = oOutlook.GetNamespace("MAPI")
        Set myFolder = oNamespace.GetDefaultFolder(6)
        Set myMail = myFolder.Items
Previous:
        For Each myItem In myMail
            On Error Resume Next
            
               For Each oAtch In myItem.Attachments
               
               If oAtch Like "*.xlsx" Then

               Debug.Print " a=" & myItem.Attachments(1)

           
               End If
               Next
        Next

If a Like "*.xlsx" Then

If myItem.Attachments(1).DisplayName = "11111.xlsx" Then

Sub Ïåðâîå_MailSave1()
    Dim oOutlook As Object ' New Outlook.Application
    Dim oNamespace As Object 'Outlook.Namespace
    Dim myFolder As Object 'Outlook.Folder
    Dim myMail As Object 'Outlook.Items
    Dim myItem As Object 'Outlook.MailItem
Dim ad As String
t = ActiveWorkbook.Path

 Set oOutlook = GetObject(, "outlook.Application")
  
        Set oNamespace = oOutlook.GetNamespace("MAPI")
        Set myFolder = oNamespace.GetDefaultFolder(6)
        Set myMail = myFolder.Items
 
 
        For Each myItem In myMail
            On Error Resume Next
                    
        'If myItem.Subject = "1" Then
        If myItem.Attachments(1).Count <> 0 And myItem.Attachments(1).Name = "11111.xlsx" Then
        Debug.Print "a=" & myItem.Attachments(1)
        Debug.Print "s=" & myItem.Subject
        End If
        Next
End Sub