Microsoft Office Forums - View Single Post - [Solved] Copy Text only of a Content Control

gmaxey · 06-16-2024, 10:03 AM

Stuart,

I just came across this post and was reading your notes on performance. After running your code, I was not seeing the issue where date type CCs was losing the selected date or date format.

Anyway, I thought that to avoid any such similar problems, why don't we never delete the original CC in the first place?

Here are two methods that never alter the original CC:

Code:

Sub Copy_CC_ContentOnly()
Dim oCC As ContentControl, oCCNested As ContentControl
Dim oRng As Range
  'This code copies the "content only" of the content control the cursor is located in.
  'It uses a temporary range variable set to end of the active document. After the code runs,
  'the content is copied to the clipboard.
  If Selection.Information(wdInContentControl) Then
    Set oCC = Selection.Range.ParentContentControl
    If Not oCC.ShowingPlaceholderText Then
      oCC.Copy
      Set oRng = ActiveDocument.Range
      oRng.Collapse wdCollapseEnd
      oRng.Paste
      Set oCC = oRng.ContentControls(1)
      oCC.LockContentControl = False
      Set oRng = oCC.Range
      oCC.Delete
      For Each oCCNested In oRng.ContentControls
        oCCNested.LockContentControl = False
        oCCNested.Delete
      Next oCCNested
      On Error Resume Next
      oRng.FormattedText.Copy
      On Error GoTo 0
      oRng.Delete
    Else
      MsgBox "The selected content control does not contain any content to copy.", _
              vbInformation + vbOKOnly, "NOTHING COPIED"
    End If
  End If
lblExit:
  Exit Sub
End Sub
Sub Copy_CC_ContentOnly_TempDoc()
Dim oCC As ContentControl, oCCNested As ContentControl
Dim oRng As Range
Dim oDoc As Document, oDocTmp As Document
  'This code copies the "content only" of the content control the cursor is located in.
  'It uses a temporary document as a range variable. After the code runs,
  'the content is copied to the clipboard.
  If Selection.Information(wdInContentControl) Then
    Set oDoc = ActiveDocument
    Set oCC = Selection.Range.ParentContentControl
    If Not oCC.ShowingPlaceholderText Then
      Set oDocTmp = Documents.Add(, , , False)
      DoEvents
      Set oRng = oDocTmp.Range
      oCC.Copy
      oRng.Collapse wdCollapseEnd
      oRng.Paste
      Set oCC = oRng.ContentControls(1)
      oCC.LockContentControl = False
      Set oRng = oCC.Range
      oCC.Delete
      For Each oCCNested In oRng.ContentControls
        oCCNested.LockContentControl = False
        oCCNested.Delete
      Next oCCNested
      oRng.FormattedText.Copy
      oDocTmp.Close wdDoNotSaveChanges
    Else
      MsgBox "The selected content control does not contain any content to copy.", _
              vbInformation + vbOKOnly, "NOTHING COPIED"
    End If
  End If
End Sub