Private Sub CommandButton1_Click()
Shell "netsh advfirewall firewall set rule name="hhhh" new enable=no", vbNormalFocus
End Sub

Sub save()
Application.DisplayAlerts = False
Filename = "C:\RRR" & "\" & Worksheets("Лист1").Range("A1") & ".xlsx"
With ActiveSheet.UsedRange
     .Value = .Value
End With
ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub

Sub send()
attach$ = ThisWorkbook.FullName
    res = SendEmailUsingOutlook("ito@yandex.ru", "Заказ", Worksheets("Лист1").Range("a1").Value, attach$)
    If res Then Debug.Print "Письмо 2 отправлено успешно" Else Debug.Print "Ошибка отправки"
End Sub

Function SendEmailUsingOutlook(ByVal Email$, ByVal MailText$, Optional ByVal Subject$ = "", _
                               Optional ByVal AttachFilename As Variant) As Boolean
   
    On Error Resume Next: Err.Clear
    Dim OA As Object: Set OA = CreateObject("Outlook.Application")
    If OA Is Nothing Then MsgBox "?? ??????? ????????? OUTLOOK ??? ???????? ?????", vbCritical: Exit Function
 
    With OA.CreateItem(0)
        .To = Email$: .Subject = Subject$: .Body = MailText$
        If VarType(AttachFilename) = vbString Then .Attachments.Add AttachFilename
        If VarType(AttachFilename) = vbObject Then
            For Each file In AttachFilename: .Attachments.Add file: Next
        End If
        For i = 1 To 100000: DoEvents: Next
        Err.Clear: .Send
        SendEmailUsingOutlook = Err = 0
    End With
    Set OutApp = Nothing
End Function

Private Sub CommandButton1_Click()
attach$ = ThisWorkbook.FullName
    res = SendEmailUsingOutlook("eeto@yandex.ru", "aaa", "bbb", attach$)
    If res Then Debug.Print "222" Else Debug.Print "3333"
End Sub

Function SendEmailUsingOutlook(ByVal Email$, ByVal MailText$, Optional ByVal Subject$ = "", _
                               Optional ByVal AttachFilename As Variant) As Boolean
   
    On Error Resume Next: Err.Clear
    Dim OA As Object: Set OA = CreateObject("Outlook.Application")
    If OA Is Nothing Then MsgBox "?? ??????? ????????? OUTLOOK ??? ???????? ?????", vbCritical: Exit Function
 
    With OA.CreateItem(0)
        .To = Email$: .Subject = Subject$: .Body = MailText$
        If VarType(AttachFilename) = vbString Then .Attachments.Add AttachFilename
        If VarType(AttachFilename) = vbObject Then
            For Each file In AttachFilename: .Attachments.Add file: Next
        End If
        For i = 1 To 100000: DoEvents: Next
        Err.Clear: .Send
        SendEmailUsingOutlook = Err = 0
    End With
    Set OutApp = Nothing
End Function

Private Sub CommandButton3_Click()
Application.DisplayAlerts = 0
    ThisWorkbook.Saved = -1
    Workbooks.Open ThisWorkbook.FullName
    Application.DisplayAlerts = -1
End Sub

Sub Статистика()
Range("A2:f2").Select
With Sheets("Лист2").UsedRange
     .Value = .Value
End With
Selection.Copy
ChDir "\\server\stat"
Workbooks.Open Filename:="1.xlsx"

????????


ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Sub Копия()
Application.DisplayAlerts = False
Filename = "\\server\Кka" & "\" & Worksheets("Лист").Range("C12") & ".xlsx"
ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub

Private Sub CommandButton1_Click()
Печать
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub


Private Sub TextBox1_Enter()
TextBox1.Value = Worksheets("Проверка" ;) .Range("b40") .Value
End Sub


Private Sub TextBox2_Enter()
TextBox2.Value = Worksheets("Проверка" ;) .Range("b40") .Value
End Sub

Private Sub TextBox3_Enter()
TextBox3.Value = Worksheets("Проверка" ;) .Range("b40") .Value
End Sub


Private Sub TextBox4_Enter()
TextBox4.Value = Worksheets("Проверка" ;) .Range("b40") .Value
End Sub

Range("a1", Cells.Find("????").Offset(-1, 0)).EntireRow.Delete