Add the following code to an ordinary module:
Code:
Option Explicit
Sub AddTable()
Dim oTable As Table
Dim oRng As Range
Dim oCell As Range
Dim i As Long
ActiveDocument.Tables(ActiveDocument.Tables.Count).Range.Copy
Set oRng = ActiveDocument.Tables(ActiveDocument.Tables.Count).Range
oRng.End = oRng.End + 1
oRng.Collapse 0
oRng.Text = vbCr
oRng.Collapse 0
oRng.Paste
For i = 1 To ActiveDocument.Tables(ActiveDocument.Tables.Count).Range.Cells.Count
ActiveDocument.Tables(ActiveDocument.Tables.Count).Range.Cells(i).Select
Select Case i
Case Is = 3, 4, 5, 8, 10, 12
Set oCell = ActiveDocument.Tables(ActiveDocument.Tables.Count).Range.Cells(i).Range
oCell.End = oCell.End - 1
oCell.Text = ""
Case Else
End Select
Next i
ActiveDocument.Tables(ActiveDocument.Tables.Count).Range.Cells(3).Select
End Sub
Then modify your existing macro to call it
Code:
Private Sub Document_ContentControlOnEnter(ByVal CCtrl As ContentControl)
Application.ScreenUpdating = False
Dim CCtrlRng As Range, TblRng As Range, i As Long, Prot As Variant, Pwd As String
With ActiveDocument
Set CCtrlRng = CCtrl.Range
If CCtrlRng.Information(wdWithInTable) Then
Set TblRng = CCtrlRng.Tables(1).Range
i = .Range(0, TblRng.End).Tables.Count
If (i < 3) Then Exit Sub
If MsgBox("Add new SBAR set?", vbQuestion + vbYesNo) = vbYes Then
Prot = .ProtectionType
If Prot <> wdNoProtection Then
Pwd = "" 'Insert password here
.Unprotect Password:=Pwd
End If
AddTable
.Protect Type:=Prot, Password:=Pwd
End If
End If
End With
Application.ScreenUpdating = True
End Sub