View Single Post
 
Old 08-14-2017, 10:31 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Try:
Code:
Sub InsertRowWithContent()
Application.ScreenUpdating = False
Dim vProtectionType As Variant, strPassword As String
Dim oRng As Word.Range, c As Long, i As Long, j As Long, t As Long
With Selection
  If .Information(wdWithInTable) Then
    With ActiveDocument
      vProtectionType = .ProtectionType
      If vProtectionType <> wdNoProtection Then
        strPassword = "" 'Insert password here
        .Unprotect Password:=strPassword
      End If
    End With
    With .Tables(1)
      j = .Range.Cells.Count + 1
      .Rows.Add
      For c = .Range.Cells.Count To j Step -1
        Set oRng = .Cell(.Range.Cells(c).RowIndex - 1, .Range.Cells(c).ColumnIndex).Range
        oRng.End = oRng.End - 1
        With .Range.Cells(c).Range
          'create new row content.
          On Error Resume Next
          .FormattedText = oRng.FormattedText
          On Error GoTo 0
          If .ContentControls.Count > 0 Then .Shading.BackgroundPatternColorIndex = wdNoHighlight
          'Work with new row content.
          For i = 1 To .ContentControls.Count
            With .ContentControls(i)
              Select Case .Type
                Case wdContentControlCheckBox: .Checked = False
                Case wdContentControlRichText, wdContentControlText, wdContentControlDate: .Range.Text = ""
                Case wdContentControlDropdownList, wdContentControlComboBox
                  t = .Type
                  .Type = wdContentControlText
                  .Range.Text = ""
                  .Type = t
                Case wdContentControlPicture
                  If Not .ShowingPlaceholderText Then
                    If .Range.InlineShapes.Count > 0 Then .Range.InlineShapes(1).Delete
                  End If
              End Select
            End With
          Next i
        End With
      Next c
    End With
    If vProtectionType > wdNoProtection Then ActiveDocument.Protect Type:=vProtectionType, Password:=strPassword
  Else
    MsgBox "The cursor must be locate in a table row containing content controls.", _
      vbInformation, vbOKOnly, "INVALID SELECTION"
  End If
End With
Application.ScreenUpdating = False
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote