I have a macro that will add either a clean row or a clean table, depending on whether the cursor is in Table 1 or Table 2 of the attached document. By "clean" I mean any user-entered text is removed and original placeholder text and content controls are restored to their defaults. I had to add an entirely new kind of table and I would like the macro to work the same as it does for Table 1. I can do very rudimentary VBA but the current macro was written by someone else and is way beyond my expertise. Any help is greatly appreciated.
Code:
Sub InsertRowWithContent()
'This is the main procedure called from the QAT icon.
Dim oRows As Word.Row, oNewRow As Row
Dim lngRow As Long
Dim oRng As Word.Range, oCellRng As Range
Dim lngIndex As Long
Dim strLocked As String
Dim arrLocked() As String
Dim oCC_Master As ContentControl, oCC_Clone As ContentControl
vProtectionType = ActiveDocument.ProtectionType
On Error Resume Next
Set oRows = p_oTargetRow
If Error <> 0 Then
If Selection.Information(wdWithInTable) Then
Set oRows = Selection.Rows(1)
End If
End If
If Not oRows Is Nothing Then
'If the selection is in a Prior Audit Issue, Regulator Issue or New Audit Issue block then pass execution to InsertNewTable
Select Case Selection.Tables(1).Title
Case "NAI", "RI", "PAI", "MSII", "PAR", "Issue Detail"
InsertNewTable Selection.Tables(1).Title
Exit Sub
End Select
Application.ScreenUpdating = False
If vProtectionType <> wdNoProtection Then
strPassword = "" 'Insert password here
ActiveDocument.Unprotect Password:=strPassword
End If
With Selection
lngRow = oRows.Index
With .Tables(1)
If .Rows.Count > lngRow Then
'Copy and paste content in new "inserted" row.
lngRow = lngRow + 1
'Copy content.
oRows.Range.Copy
'Bug in Word - CCs in following row must be unlocked
For Each oCC_Master In .Rows(lngRow).Range.ContentControls
strLocked = oCC_Master.LockContentControl & ","
oCC_Master.LockContentControl = False
Next oCC_Master
strLocked = Left(strLocked, Len(strLocked) - 1)
Set oNewRow = .Rows.Add(.Rows(lngRow))
Set oRng = .Rows(lngRow).Range
oRng.MoveEnd wdCharacter, -1
oRng.Paste
If InStr(.Cell(1, 1).Range.Text, "New Audit Issues") = 1 Then
oNewRow.Cells(1).Range.Text = ""
oNewRow.Cells(3).Range.Text = ""
oNewRow.Cells(4).Range.Text = ""
oNewRow.Range.ContentControls(1).DropdownListEntries(1).Select
oNewRow.Cells(2).Shading.BackgroundPatternColorIndex = wdNoHighlight
oNewRow.Range.ContentControls(2).Range.Text = ""
End If
If InStr(.Cell(1, 1).Range.Text, "Business Line") = 1 Then
oNewRow.Cells(1).Range.Text = ""
oNewRow.Cells(2).Range.Text = ""
oNewRow.Cells(3).Range.Text = ""
oNewRow.Range.Shading.BackgroundPatternColorIndex = wdNoHighlight
For lngIndex = 1 To 6
oNewRow.Range.ContentControls(lngIndex).DropdownListEntries(1).Select
Next
End If
arrLocked = Split(strLocked, ",")
For lngIndex = 1 To UBound(arrLocked)
.Rows(lngRow).Range.ContentControls(lngIndex + 1).LockContentControl = arrLocked(lngIndex)
Next lngIndex
Else
'Copy and paste row content in new appended row.
.Rows.Last.Range.Copy
'Append new row.
Set oNewRow = .Rows.Add
Set oRng = .Rows.Last.Range
'Clip end of row mark.
oRng.MoveEnd wdCharacter, -1
'Paste content.
oRng.Paste
If InStr(.Cell(1, 1).Range.Text, "New Audit Issues") = 1 Then
oNewRow.Cells(1).Range.Text = ""
oNewRow.Cells(3).Range.Text = ""
oNewRow.Cells(4).Range.Text = ""
oNewRow.Range.ContentControls(1).DropdownListEntries(1).Select
oNewRow.Cells(2).Shading.BackgroundPatternColorIndex = wdNoHighlight
oNewRow.Range.ContentControls(2).Range.Text = ""
End If
If InStr(.Cell(1, 1).Range.Text, "Business Line") = 1 Then
oNewRow.Cells(1).Range.Text = ""
oNewRow.Cells(2).Range.Text = ""
oNewRow.Cells(3).Range.Text = ""
oNewRow.Range.Shading.BackgroundPatternColorIndex = wdNoHighlight
For lngIndex = 1 To 6
oNewRow.Range.ContentControls(lngIndex).DropdownListEntries(1).Select
Next
End If
lngRow = lngRow + 1
End If
'Work with new row content.
With .Rows(lngRow)
For lngIndex = 1 To .Previous.Range.ContentControls.Count
Set oCC_Master = .Previous.Range.ContentControls(lngIndex)
Set oCC_Clone = .Range.ContentControls(lngIndex)
With oCC_Clone
#If VBA7 Then
If Int(Application.Version) >= 14 Then
If .Type = wdContentControlCheckBox Then
.Checked = False
End If
End If
#End If
If .Type = wdContentControlRichText Or _
.Type = wdContentControlText Or _
.Type = wdContentControlDate Then
If Not .ShowingPlaceholderText Then
.Range.Text = ""
End If
End If
If .Type = wdContentControlDropdownList Or .Type = wdContentControlComboBox Then
.DropdownListEntries(1).Select
End If
If .Type = wdContentControlPicture Then
If Not .ShowingPlaceholderText Then
If .Range.InlineShapes.Count > 0 Then
.Range.InlineShapes(1).Delete
.Range.InlineShapes(1).Width = oCC_Master.Range.InlineShapes(1).Width
End If
End If
End If
If .Type = wdContentControlDate Then .Range.Text = ""
.LockContentControl = oCC_Master.LockContentControl
End With
Next lngIndex
End With
End With
End With
If vProtectionType > -1 Then
ActiveDocument.Protect Type:=vProtectionType, Password:=strPassword
End If
Application.ScreenUpdating = True
Set p_oTargetRow = Nothing
Else
MsgBox "The cursor must be in a table row containing content controls.", _
vbInformation + vbOKOnly, "INVALID SELECTION"
End If
End Sub