Sub MMM()
    Dim rng As Range, cel As Range
    Set rng = Range("A100:A124")
    For n = rng.Cells.Count To 1 Step -1
        Set cel = rng(n, 1)
        If cel.MergeCells Then
          Set Merg = cel.MergeArea.Cells
            For i = Merg.Count To 2 Step -1
                n = n - 1
                Rows(Merg(i, 1).Row).Delete
            Next
        End If
    Next

End Sub

    [A10] = Split(text, Chr(10))(0)
    [A12] = Split(text, Chr(10))(0)

'............
 Set tbl = Selection.Tables(1)
   ColumnIndex = Selection.Cells(1).ColumnIndex
 '............  
    tbl.cell(rowIndex + 1, ColumnIndex).Range.InlineShapes.AddPicture FileName:=picFiles(i), LinkToFile:=False, SaveWithDocument:=True

Sub InsertSelectedPicturesIntoExistingTableFromCursor()
    Dim dlgOpen As FileDialog
    Dim picFiles() As Variant
    Dim tbl As Table
    Dim rowIndex As Integer
    Dim i As Integer

    Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)
    With dlgOpen
        .Title = "CHOOSE IMAGE"
        .Filters.Clear
        .Filters.Add "IMAGE", "*.jpg; *.jpeg; *.png; *.gif", 1
        .AllowMultiSelect = True
        i = -1
        If .Show = -1 Then
            For n = 1 To .SelectedItems.Count
                i = i + 1
                ReDim Preserve picFiles(i)
                picFiles(i) = .SelectedItems.Item(n)
            Next
        Else
            Exit Sub
        End If
    End With

    If ActiveDocument.Tables.Count = 0 Then
        MsgBox "NO TABLE IN THE DOCUMENT", vbExclamation
        Exit Sub
    End If

    Set tbl = Selection.Tables(1)
    rowIndex = Selection.Cells(1).rowIndex
    For i = LBound(picFiles) To UBound(picFiles)

        If rowIndex <= tbl.Rows.Count Then
            tbl.Rows.Add
        End If


        tbl.Cell(rowIndex + 1, 1).Range.InlineShapes.AddPicture FileName:=picFiles(i), LinkToFile:=False, SaveWithDocument:=True


        rowIndex = rowIndex + 1
    Next i

    MsgBox "DONE! INSERTED", UBound(picFiles) - LBound(picFiles) + 1, "IMAGES"
End Sub

    With xOtlMail
    .To = "Email Address"
    .CC = "Email Address"
    .BCC = "Email Address"
    .Subject = "Subject line"
   .DeferredDeliveryTime =дата планируемой отправки
    .HTMLBody = .HTMLBody & xStrBody
    .Display
    End With

Sub ClearForm()
    Dim ws As Worksheet
    Dim oleObj As Shape
    Set ws = ThisWorkbook.Sheets("start")
    For Each oleObj In ws.Shapes
       If TypeName(oleObj.DrawingObject) = "OptionButton" Or TypeName(oleObj.DrawingObject) = "CheckBox" Then
            oleObj.DrawingObject.Value = False
        End If
    Next oleObj
End Sub

Private Sub Пуск_Click()
    Dim i
    If Range("AO11") = "Кран закрыт" Then
        MsgBox "Выполнен запуск ГПА"
        For i = 0 To 7
            Me.Shapes("TextBox 29").TextFrame2.TextRange.Text = i
            Pausa 0.5
        Next
    Else
        MsgBox "Проверь корректность положения ТПА внешней технологичнеской обвязки"
    End If
End Sub
Function Pausa(t)
    Dim d
    d = Timer + t
    Do While Timer < d
        DoEvents
    Loop
End Function