Public Sub CommandButton4_Click()
'Sub Macros1()
'
' Macros1 Macros
'Private
Dim FF As String ' Variant
Worksheets("База").Unprotect Password:="123"
Dim sFileName As String, sNewFileName As String, m
sFileName = GetFileName("Выберите фото", ThisWorkbook.Path)
If sFileName = "" Then Exit Sub
   
       
    m = Split(sFileName, "\")
    sNewFileName = "P:\COPY\Внутренние аудиты по ОТ и ПБ\photo\" & m(UBound(m)) '
       
    FileCopy sFileName, sNewFileName
'Stop
    FF = "=HYPERLINK(""" & sNewFileName & ""","">>>"")"
       
    MsgBox "Done", vbInformation

End Sub

закуптаб.Cells(i, j)

все_люди.Cells(a, b)

if символы с 1 по 7 в закуптаб.Cells(i, j) = символы с 9 по 15 в все_люди.Cells(a, b) then

For i = 4 To lLastRow
  For j = 7 To lLastCol
    If Cells(i, j).Interior.Color = 255 Then
       For a = 7 To lLastCol
        If Cells(2, j) = çàêóïêà.Cells(2, 16) Then 'ïîèñê îäèíàêîâûõ ÑÈÇ
            If çàêóïêà.Cells(3, a) = 4 Then ' åñëè âèä ÑÈÇ 4-êà ïðîñòî äîáîâëÿåòñÿ 1 ê ïðåäûä-ìó çíà÷åíèþ ÿ÷åéêè.
             Cells(i, j) = Cells(i, j) + 1
            Else
              If çàêóïêà.Cells(3, a) = 3 Then 'åñëè âèä ÑÈÇ 3-êà ýòî îáóâü è äîáîâëÿåòñÿ
                  For b = 4 To 17
                    If Cells(i, 6) = çàêóïêà.Cells(b, 6) Then ' ïîèñê ñîâïàäåíèÿ ðàçìåðà
                    çàêóïêà.Cells(b, a) = çàêóïêà.Cells(b, a) + 1
                    End If
                  Next b
              Else
               ñ = Cells(, Columns.Count).End(xlToLeft).Column
               çàêóïêà.Cells(ñ + 1, a) = Cells(i, 5)
               çàêóïêà.Cells(ñ + 1, a - 1) = Cells(i, 4)
              End If
            End If
        End If
        Next a
    End If
    Next j
Next i

End Sub

Sub Кнопка4_Щелкнуть()

Dim mLastBasa As Long, M As Long
Dim iLastStat As Long, i As Long
Dim iLastDannye As Long
Dim iLastDannyeS As Long
Dim nLastRow As Long, n As Long

aa= "=ОКРУГЛ((D" & M + 8 & "/C" & M + 8 & "*100);0)"

Sub Button4_Click()

lDaysCnt = DateDiff("d", "20.11.2012", Now) 

lDaysCnt= DateDiff("d", "Worksheets("Base").Cells(2, 1)", Now)

 If Day(Date) > ws.Cells(m, 28)  Then

Private Sub CommandButton4_Click()
'
' Macros1 Macros
'

Dim ws As Worksheet
Set ws = Worksheets("База")
Dim Adres As Object
Dim F As Long
Dim iRow As Long
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

             Adres = Application.GetOpenFilename("Все рисунки(*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;*.dib;*.rle;*.gif;*.emz;*.wmz;*.pcz;*.tif;*.tiff;*.cgm;*.eps;*.wpg),*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;*.dib;*.rle;*.gif;*.emz;*.wmz;*.pcz;*.tif;*.tiff;*.cgm;*.eps;*.wpg")

    If Adres = False Then ' Файл не выбран
        Exit Sub
        End If
F = "=HYPERLINK(""" & Adres & """,""Картинка ""&ROW())"
    Worksheets("База").Cells(iRow, "AD").Value = F
    'ActiveCell.FormulaR1C1 = F
    Range("B4").Select

End Sub

Worksheets("База").Cells(iRow, "AD").Value = некая гипер ссылка кликнув по которой откроется картинка

Private Sub ComboBox2_Change()
'ComboBox2.Value = Format(ComboBox2.Value, "h:mm" )
'ActiveCell = ComboBox2.Value
'ActiveCell.NumberFormat = "h:mm;0"
'Unload UserForm_Time
' UserForm_Time.Hide ' Это лишнее
'Unload Form_SelectDate ' А это?
End Sub

    Dim OutApp As Object
    Dim OutMail As Object
     Dim tt As String
    Dim cell As Range
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")   'запускаем Outlook в скрытом режиме
    OutApp.Session.Logon
    On Error GoTo cleanup  'если не запустился - выходим
    Set OutMail = OutApp.CreateItem(0)   'создаем новое сообщение
    On Error Resume Next
    'заполняем поля сообщения
 With OutMail
        .To = Sheets("Данные").Cells(ComboBox4.ListIndex + 2, 4).Value  'Sheets("Данные").Cells(АудиторФИО.ListIndex + 2, 2)
        .cc = "KhitrovIA@biaxplen.ru"
        .Subject = "ПАБ " & "Автоматическая рассылка" '.Value

        .Body = "Добрый день " & Sheets("База").Cells(iRow, 15) & " " & vbCrLf & " " & Sheets("База").Cells(iRow, 1) & " " & vbCrLf & "во время: " & Sheets("База").Cells(iRow, 6) & vbCrLf & "мною была выявлена следующая опасная ситуация: " & Sheets("База").Cells(iRow, 9).Value & vbCrLf & "прошу Вас принать корректируюшие меры в виде: " & Sheets("База").Cells(iRow, 13) & vbCrLf & "Сроком до: " & Sheets("База").Cells(iRow, 17) & vbCrLf & "Если Вы уверены что Вас ошибочно назначили Ответственным за устранение данной опасной ситуации, перешлите письмо (добавив меня и ОТ,ПБ в копию) другому Ответственному который сможет/должен устранить эту ОС" '.Value
        .Attachments.Add Range("A4").Value
        'команду Send можно заменить на Display, чтобы посмотреть сообщение перед отправкой
        .Display 'Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    

.....
IF    CheckBox(2, 4, 5, 7, 9, 14) true_one(CheckBox) then
      Событие1
End IF  

IF    CheckBox(2, 4, 5, 7, 9, 14) true_two(CheckBox) then
      Событие2
End IF 

IF    CheckBox(2, 4, 5, 7, 9, 14) true_two(CheckBox) then
      Событие3
End IF 

....

Private Sub CheckBox20_Click()
n=24  ' номер текстбокса последний на UserForm который уже есть
create TextBox(n+1) ' создается текстбокс следующий по номеру
put TextBox(n+1) on(x, y) 'расположение техтбокса на поле UserForm1 по координатам x и y

----------дальше при снятии галки с ЧекБокса созданный ТекстБок должен удаляться---------

End Sub

 TextBox1.BackColor.Color = RGB(220, 230, 241)

TextBox1.BackColor.ColorIndex = vbRed

If Cells(1, 2) = Error Then             ' тут проверяется не ошибочно ли ввел оператор дату (например 13,04,2015)
   Target.Cells = Empty                 ' если ошибочно то дата стирается
 Call Макрос3                               ' и запускается бокс с пояснением
Cells(3, 1) = "OK"                         ' а если дата правильно ввели то в ячейке (3, 1) появляется ОК
    End If