Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
Cancel = True
ElseIf Range("D5").Value = 0 Then
ActiveSheet.Shapes("Option Button 1").Visible = False
ElseIf Range("D5").Value <> 0 Then
ActiveSheet.Shapes("Option Button 1").Visible = True
ElseIf Range("D8").Value = 0 Then
ActiveSheet.Shapes("Option Button 2").Visible = False
ElseIf Range("D8").Value <> 0 Then
ActiveSheet.Shapes("Option Button 2").Visible = True
ElseIf Range("D11").Value = 0 Then
ActiveSheet.Shapes("Option Button 3").Visible = False
ElseIf Range("D11").Value <> 0 Then
ActiveSheet.Shapes("Option Button 3").Visible = True
End If
End Sub

Private Sub Worksheet_selectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Me.CommandButton1.Top = Cells(Target.Row + 1, 2).Top + Cells(Target.Row + 1, 2).Height
Me.CommandButton1.Left = Target.Left + 180
Me.ComboBox1.Top = Cells(Target.Row + 1, 2).Top + Cells(Target.Row + 1, 2).Height
Me.ComboBox1.Left = Target.Left
End Sub

Private Sub CommandButton1_Click()
MsgBox "Приветик! :-)", vbInformation, ""
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B2")) Is Nothing Then
Cancel = True
Range("D4").ClearContents
End If
End Sub

или

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B2")) Is Nothing Then
Cancel = True
Range("D4").Select
Selection.ClearContents
Range("B2").Select
End If
End Sub

Sub InsertPicture() 

Dim wdTable As Object
Dim objWrdDoc As Object
Dim strFile As String
Dim p As InlineShape, t As Object
Dim pShape As Object

On Error Resume Next

strFile = Range("E8").Value                           'путь к документу (можно "d:\...\Документ.docx")
Set objWrdApp = GetObject(, "Word.Application")       'пытаемся подключится к объекту Word
If objWrdApp Is Nothing Then
    Set objWrdApp = CreateObject("Word.Application")  'если приложение закрыто - создаем новый экземпляр
    Set objWrdDoc = objWrdApp.Documents.Open(strFile) 'открываем документ Word - документ с таким именем должен существовать
    objWrdApp.Visible = True
End If
Set objWrdDoc = objWrdApp.Documents.Open(strFile)
On Error GoTo 0
    
Set WdRange = objWrdDoc.Content
Set wdTable = WdRange.Tables(1)

Set p = wdTable.Rows(1).Cells(1).Range.InlineShapes.AddPicture(Range("C11").Value, False, True) ' путь к картинке (можно "d:\...\печать.png")

'вставка в документ
p.ScaleWidth = 20
p.ScaleHeight = 20
Set t = p.ConvertToShape
t.WrapFormat.Type = wdWrapNone

t.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
t.RelativeVerticalPosition = wdRelativeVerticalPositionPage
t.Left = 260                                                    'значения, конкретно под этот случай
t.Top = 370                                                     'значения, конкретно под этот случай

End Sub

Sub Test()
    Dim Sh As Worksheet, wb As Workbook, FileStart As String, FileNew As String
    Application.ScreenUpdating = False
    Set Sh = ThisWorkbook.Worksheets("1")
    FileSt = Sh.Range("C30").Value
    FileNew = Sh.Range("C33").Value
    Set wb = Workbooks.Open(FileSt)
    wb.SaveAs Filename:=FileNew, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    wb.Activate
    Application.Wait (Now() + TimeValue("00:00:02"))
    Shell "cmd /C start """" ""\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\avto\готовые документы\""", vbNormalFocus
    ThisWorkbook.Close (True)
    Application.ScreenUpdating = True

End Sub

Sub obj_select()

' макрос для выбора скрипта в зависимости от типа исходного шаблона (Word или Excel);

If (Условие_1) Then
    Application.Run "'1.xlsm'!objWord.objWord"
Else
    Application.Run "'1.xlsm'!objExcel.objExcel"
End If

End Sub

Sub objWord() 'скрипт создания файла word на основании таблицы excel

Dim objWord As Object
Dim FileStart
Dim FileNew

'обновление ячейки для добавления времени в имя файла
Range("E29").FormulaR1C1 = "=NOW()"

Set objWord = CreateObject("Word.Application")

FileSt = Range("C30").Value   'исходный файл (шаблон), можно указать путь "g:\2.docx" или "\\fuib.com\kho\DOCUMENTYOOKUTU\..."
FileNew = Range("C33").Value  'новый файл, можно указать путь "g:\5.docx" или "\\fuib.com\kho\DOCUMENTYOOKUTU\..." (с внесёнными закладками word - "Вставка" - "Закладки")
    
Set objDoc = objWord.Documents.Open(FileSt)

objWord.Visible = False  'если вместо objWord.Visible = True написать objWord.Visible = False, то Шаблон Word появляться не будет

objDoc.Bookmarks("okpo").Range.InsertAfter (Cells(35, 3).Value)
On Error Resume Next
objDoc.Bookmarks("nazv_kr").Range.InsertAfter (Cells(36, 3).Value)
On Error Resume Next
   
objWord.ActiveDocument.SaveAs _
        Filename:=FileNew, _
        FileFormat:=wdFormatDocument, _
        Password:="", _
        AddToRecentFiles:=True, _
        WritePassword:="", _
        ReadOnlyRecommended:=False
objWord.Quit

Dim objWrdApp As Object 'открытие нового файла
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(FileNew)
    objWord.Visible = True  'если вместо objWord.Visible = True написать objWord.Visible = False, то Шаблон Word появляться не будет

'активация окна word
objWord.Activate

'пауза 2 сек.
Application.Wait (Now() + TimeValue("00:00:02"))

'открытие "Проводника" в папке;
Shell "cmd /C start """" ""\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\avto\готовые документы\""", vbNormalFocus

End Sub

Sub objExcel() 'скрипт копирования файла excel из таблицы excel и заполнение ячеек на основании таблицы excel

Dim objExcel As Object
Dim FileStart
Dim FileNew

'обновление ячейки для добавления времени в имя файла
Range("E29").FormulaR1C1 = "=NOW()"

Set objExcel = CreateObject("Excel.Application")

'исходный файл (шаблон), можно указать путь "g:\2.xlsx" или "\\fuib.com\kho\DOCUMENTYOOKUTU\..."
FileSt = Range("C30").Value

'новый файл, можно указать путь "g:\5.xlsx" или "\\fuib.com\kho\DOCUMENTYOOKUTU\..."
FileNew = Range("C33").Value
    
Set objWorkbook = Workbooks.Open(FileSt)

'если написать objExcel.Application.Visible = True, то Шаблон появляться будет
objExcel.Application.Visible = False
   
ActiveWorkbook.SaveAs _
         Filename:=FileNew, _
         FileFormat:=xlOpenXMLWorkbook, _
         CreateBackup:=False
objExcel.Quit

'открытие нового файла
Dim objExcelApp As Object
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = Workbooks.Open(FileNew)
    objExcel.Visible = True  'если написать oobjExcel.Visible = False, то Шаблон появляться не будет

'активация окна нового файла
Workbooks(2).Activate
ActiveWindow.WindowState = xlMaximized

'пауза 2 сек.
Application.Wait (Now() + TimeValue("00:00:02"))

'открытие "Проводника" в папке;
Shell "cmd /C start """" ""\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\avto\готовые документы\""", vbNormalFocus

End Sub

Sub obj2() 'скрипт копирования файла excel из таблицы excel и заполнение ячеек на основании таблицы excel

Dim objExcel As Object
Dim FileStart
Dim FileNew

'обновление ячейки для добавления времени в имя файла
Range("E29").FormulaR1C1 = "=NOW()"

Set objExcel = CreateObject("Excel.Application")

'исходный файл (шаблон), можно указать путь "g:\2.xlsx" или "\\fuib.com\kho\DOCUMENTYOOKUTU\..."
FileSt = Range("C30").Value

'новый файл, можно указать путь "g:\5.xlsx" или "\\fuib.com\kho\DOCUMENTYOOKUTU\..."
FileNew = Range("C33").Value
    
Set objWorkbook = Workbooks.Open(FileSt)

'если написать objExcel.Application.Visible = True, то Шаблон появляться будет
objExcel.Application.Visible = False
   
' описание файлов при сохранении https://www.mrexcel.com/board/threads/vba-saveas-fileformat-variable.759381/
ActiveWorkbook.SaveAs _
         Filename:=FileNew, _
         FileFormat:=xlOpenXMLWorkbook, _
         CreateBackup:=False
objExcel.Quit

'открытие нового файла
Dim objExcelApp As Object
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = Workbooks.Open(FileNew)
    objExcel.Visible = True  'если написать oobjExcel.Visible = False, то Шаблон появляться не будет

'активация окна нового файла
Workbooks(2).Activate
ActiveWindow.WindowState = xlMaximized

'пауза 2 сек.
Application.Wait (Now() + TimeValue("00:00:02"))

'открытие "Проводника" в папке; источник https://vremya-ne-zhdet.ru/vba-excel/otkryt-papku-v-provodnike/#Otkrytie_papki_v_provodnike
Shell "cmd /C start """" ""\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\avto\готовые документы\""", vbNormalFocus

End Sub

"\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\закрытие счетов\заявление о закрытии счёта ЮЛ.doc"; "\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\тарифы\Раздел 1. Расчетно-кассовое обслуживание.doc"; "\\fuib.com\kho\DOCUMENTYOOKUTU\Кулиничев\! открытие счетов\реквизиты на оплату\!Реквизиты - закрытие счетов (КНО).doc"

Option Explicit
 
Sub Send_mail_shablony_documentov()  'Источник https://www.excel-vba.ru/chto-umeet-excel/kak-otpravit-pismo-iz-excel/

' макрос для отправки сообщений

    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
 
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    'раскомментировать строку, если в Outlook несколько учетных записей и нужно подключиться к конкретной(только если Outlook закрыть)
    '   [параметры]: Session.Logon "имя профиля","пароль",[показывать окно выбора профиля], [запускать в новой сессии]
    'objOutlookApp.Session.Logon "profile","1234",False, True
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
    sTo = Range("G3").Value             'Кому(можно заменить значением из ячейки - sTo = "AddressTo@mail.ru")
    sSubject = Range("G4").Value        'Тема письма(можно заменить значением из ячейки - sSubject = "Автоотправка")
    sBody = Range("G5").Value           'Текст письма(можно заменить значением из ячейки - sBody = "Привет от Excel-VBA")
    sAttachment = Range("G6").Value     'Вложение(полный путь к файлу. Можно заменить значением из ячейки или путь - sAttachment = "C:\Temp\Книга1.xls")
    
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        '.CC = Range("B3").Value 'адрес для копии
        .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) / .Body = sBody - обычный текст сообщения
        'добавляем вложение, если файл по указанному пути существует(dir проверяет это)
        If sAttachment <> "" Then
            If Dir(sAttachment, 16) <> "" Then
                .Attachments.Add sAttachment 'просто вложение
                'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
            End If
        End If
        .display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра; .Send - сразу отправка
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

    ActiveCell.Offset(0, 0).Select
    Selection.Copy
    Sheets("инфо по клиенту").Select
    Range("H2:L2").Select
    ActiveSheet.Paste
End Sub