Application.Dialogs(xlDialogSendMail).Show

Private Sub Workbook_Open()
Application.CommandBars(35).Controls(1).Controls(28).OnAction = "zapret"
End Sub

Public Sub zapret()
MsgBox "вам запрещено отправлять книгу по почте!", vbCritical
End Sub

MsgBox "данные обработаны за  " & Timer - t & " сек.", vbInformation

Sub opening()
    Dim sFolder As String, sFiles As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)    
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'Открытие книги
        Workbooks.Open sFolder & sFiles
        'действие с файлом
            Application.Run "'" & sFiles & "'!All.all_in_one"        
        ActiveWorkbook.Close True
        sFiles = Dir
    Loop
End Sub

Public CheckForPlan As Boolean
Sub all_in_one()
t = Timer
Call оргструктура
Call продажи
Call инвестиции
MsgBox "данные обработаны за " & Round(Timer - t, 2) & " сек.", vbInformation
End Sub

Sub Макрос1()
Dim shA As Worksheet, shB As Worksheet
Dim masA As Range, masB As Range
Dim r As Long, k As Long, rSh1 As Long, kSh1 As Long

Set shB = ActiveWorkbook.Sheets(1)
Set shA = ActiveWorkbook.Sheets(Sheets.Count)

Set masB = shB.UsedRange
Set masA = shA.UsedRange

r = masA.Rows.Count
k = masA.Columns.Count
rSh1 = masB.Rows.Count
kSh1 = masB.Columns.Count

'перенос данных на лист shB
Application.ScreenUpdating = False
    shB.Rows("1:" & rSh1).Delete
    Range(shB.Cells(1, 1), shB.Cells(r, k)).Value = masA.Value
    Set masB = shB.UsedRange
        For i = 1 To masA.Cells.Count
            masB.Cells(i).Interior.Color = masA.Cells(i).Interior.Color
        Next i
Application.ScreenUpdating = True
End Sub

Sub ToggleCaseMacro()
Set shA = ActiveWorkbook.Sheets(1)
shA.Unprotect 1213
    Selection.EntireRow.Delete
If shA.ProtectContents = False Then
shA.Protect Password:=1213, UserInterfaceOnly:=True, DrawingObjects:=False, AllowFormattingColumns:=True, _
        AllowInsertingRows:=True, AllowDeletingColumns:=False, AllowSorting:=False, AllowFiltering:=True
End If
End Sub
Sub ToggleCaseMacro1()
Set shA = ActiveWorkbook.Sheets(1)
shA.Unprotect 1213
    Selection.EntireRow.Delete
If shA.ProtectContents = False Then
shA.Protect Password:=1213, UserInterfaceOnly:=True, DrawingObjects:=False, AllowFormattingColumns:=True, _
        AllowInsertingRows:=True, AllowDeletingColumns:=False, AllowSorting:=False, AllowFiltering:=True
End If
End Sub
Sub DeleteFromCellMenu()
    Dim ContextMenu As CommandBar
    Dim ContextMenu1 As CommandBar
    Dim ContextMenu2 As CommandBar
    Dim ctrl As CommandBarControl
    Dim ctrl1 As CommandBarControl

    ' Устанавливаем контекстное меню для ячейки строки и столбца
    Set ContextMenu = Application.CommandBars("Cell")
    Set ContextMenu1 = Application.CommandBars("row")
    Set ContextMenu2 = Application.CommandBars("column")
     
' Удаляем тег "удалить строку(и)" если он уже существует
    For Each ctrl In ContextMenu.Controls
        If ctrl.Tag = "Удалить сроку(и)" Then
            ctrl.Delete
        End If
    Next ctrl
' Удаляем тег "удалить строку" если он уже существует
    For Each ctrl1 In ContextMenu1.Controls
        If ctrl1.Tag = "Удалить сроку" Then
            ctrl1.Delete
        End If
    Next ctrl1
     
'Удаляем стандартные кнопки удалить в контекстном меню
     On Error Resume Next
    ContextMenu.FindControl(ID:=292).Delete
    ContextMenu1.FindControl(ID:=293).Delete
    ContextMenu2.FindControl(ID:=294).Delete
    On Error GoTo 0
End Sub
Sub Reset_All_Bars()
Dim cmbComBar As CommandBar
On Error Resume Next
For Each cmbComBar In CommandBars
cmbComBar.Reset: cmbComBar.Enabled = True
Next cmbComBar
End Sub

Public Sub Workbook_Activate()
    Dim ContextMenu As CommandBar
    Dim ContextMenu1 As CommandBar
    ' Delete the controls first to avoid duplicates.
    Call DeleteFromCellMenu
    ' Set ContextMenu to the Cell context menu.
    Set ContextMenu = Application.CommandBars("Cell")
    ' Add one custom button to the Cell context menu.
    With ContextMenu.Controls.Add(Type:=msoControlButton, before:=7)
        .OnAction = "ToggleCaseMacro"
        .Caption = "Удалить сроку(и)"
        .Tag = "Удалить сроку(и)"
    End With
    
    Set ContextMenu1 = Application.CommandBars("row")
    With ContextMenu1.Controls.Add(Type:=msoControlButton, before:=7)
        .OnAction = "ToggleCaseMacro1"
        .Caption = "Удалить сроку"
        .Tag = "Удалить сроку"
    End With
End Sub
Public Sub Workbook_Deactivate()
Call Reset_All_Bars
End Sub

Sub Worksheet_Change(ByVal Target As Range)

myRange.Copy [a2]
 

myRange.Copy  
[a2].paste 

Sub Workbook_Open()
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Set myRange = Range(Cells(1, 1), Cells(2, 2))

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
End Sub
 

Sub Worksheet_Change(ByVal Target As Range)  
Cells(3, 2).Interior.Color = myRange (1, 1).Interior.Color

Public myRange As Variant
 

Sub macros1 ()
Dim myRange As Variant
  Set myRange = [a1]
  [a2] = myRange
End Sub
 

Sub macros1 ()
Dim myRange As Variant
  Set myRange = [a1]
  [a2].Interior.Color = myRange.Interior.Color  
  [a2].Font.Color = myRange.Font.Color  
End Sub