View Single Post
 
Old 10-24-2019, 01:58 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,144
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Probably something like

Code:
Sub Macro1()
Dim oRng As Range
Dim oTable As Table
Dim oCell As Range
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(findText:="T. ")
            If oRng.Start = oRng.Paragraphs(1).Range.Start Then
                oRng.End = oRng.Paragraphs(1).Range.End
                oRng.Collapse 0
                Set oTable = ActiveDocument.Tables.Add(oRng, 2, 3)
                With oTable
                    .Columns(1).Width = CentimetersToPoints(1.17)
                    .Columns(2).Width = CentimetersToPoints(1.47)
                    .Columns(3).Width = CentimetersToPoints(13.35)
                    Set oCell = .Cell(1, 1).Range
                    oCell.End = oCell.End - 1
                    oCell.Text = "Date"
                    Set oCell = .Cell(1, 2).Range
                    oCell.End = oCell.End - 1
                    oCell.Text = "Initials"
                    Set oCell = .Cell(1, 3).Range
                    oCell.End = oCell.End - 1
                    oCell.Text = "Remarks"
                End With
            End If
        Loop
    End With
    Set oRng = Nothing
    Set oCell = Nothing
    Set oRng = Nothing
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote