Insert Content Control Bug

[gmaxey]

Yesterday, I got interested in a thread posted in the Microsoft Answers site.


Date functions on a word doc


This morning, I thought I would try to create a simple automated process for creating any number of incremented date entries in a document and I got tripped up on a long lingering apparent bug, in the Content Control Add method. I recall fumbling around with this issue years ago, but that was years ago and brain is fogged.


I wanted to outline the issue (as I understand it) here to perhaps save others from falling over the same problem.


Run the following macro with the line oRng.Select stetted out as shown. This macro is basically trying to add a series of plain text content controls.


You will get an RTE 4605 - This property or method is not available because the current selection partially covers a plain text content control.

Sub CreateSequentialIncrementingDatesII()
Dim oRng As Range
Dim oCC As ContentControl
Dim varParts As Variant
Dim lngIndex As Long
  Application.ScreenUpdating = False
  varParts = Split(InputBox("Please enter a) a unique set name, b) the number of days to increment each subesequent date," _
                 & " c) the number of incremented dates you need and c) the number of days " & vbCr & vbCr _
                 & "Note - The default format will produce sequential 8 dates incremented 7 days.", "SET DEFINIITON", "Set1|7|8"), "|")
  Set oRng = Selection.Range
  oRng.Collapse wdCollapseStart
  For lngIndex = varParts(2) To 1 Step -1
    With oRng.ContentControls.Add(wdContentControlText)
      .Title = varParts(0)
      .Tag = lngIndex
      .SetPlaceholderText , , "Incremented Date"
    End With
    oRng.Text = vbCr
    oRng.Collapse wdCollapseStart
    'If you add Plain Text CCs with code, you have to "select" the redefined range.
    'oRng.Select
  Next lngIndex
  Set oCC = oRng.ContentControls.Add(wdContentControlDate)
  With oCC
    .Title = "Input"
    .Tag = varParts(0) & "|" & varParts(1)
    .SetPlaceholderText , , "Enter start date and exit"
    .Range.Text = Now
  End With
  'Call the CC Exit Event
  Document_ContentControlOnExit oCC, False
  Application.ScreenUpdating = True
  Application.ScreenRefresh
lbl_Exit:
  Exit Sub
End Sub

Unstet the line oRng.Select and run the code again and it performs normally.


Now I concur that the current selection might cover or partially cover a plain text content control, but the current selection has no association with the defined range that we are attempting to add another content control. Right? Consider:

Sub DemoI()
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  oRng.Text = vbCr & vbCr & vbCr & vbCr
  Set oRng = ActiveDocument.Paragraphs(1).Range 'The first paragraph
  oRng.Collapse wdCollapseStart
  oRng.ContentControls.Add wdContentControlText
  Set oRng = ActiveDocument.Paragraphs(5).Range 'The last paragraph
  oRng.Collapse wdCollapseStart
  On Error GoTo Err_Handler
  oRng.ContentControls.Add wdContentControlText
lbl_Exit:
  Exit Sub
Err_Handler:
  Select Case Err.Number
    Case 4605
      MsgBox Err.Number & "-" & Err.Description & vbCr + vbCr _
        & "Why?? - The range we are attempting to add the CC has no relationship to the current selection"
      oRng.Select
      Resume
    End Select
  Resume lbl_Exit
End Sub

I have discovered that if I don't collapse the range in the Demo code, the inserted content control does not get selected and the error does not occur:

Sub DemoII()
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  oRng.Text = vbCr & vbCr & vbCr & vbCr
  Set oRng = ActiveDocument.Paragraphs(1).Range 'The first paragraph
  'oRng.Collapse wdCollapseStart
  oRng.ContentControls.Add wdContentControlText
  Set oRng = ActiveDocument.Paragraphs(5).Range 'The last paragraph
  oRng.Collapse wdCollapseStart
  On Error GoTo Err_Handler
  oRng.ContentControls.Add wdContentControlText
lbl_Exit:
  Exit Sub
Err_Handler:
  Select Case Err.Number
    Case 4605
      MsgBox Err.Number & "-" & Err.Description & vbCr + vbCr _
        & "Why?? - The range we are attempting to add the CC has no relationship to the current selection"
      oRng.Select
      Resume
    End Select
  Resume lbl_Exit
End Sub

But, in my project, I need to collapse the range. I have also discovered the problem does not occur with the range collapsed if you use RichText content controls:


That's it. I can't explain why the error occurs but there are some potential work a rounds. For my project, I needed to collapse the range, I don't like using oRng.Select and I didn't want rich text CCs. I used:

Sub CreateSequentialIncrementingDates()
Dim oRng As Range
Dim oCC As ContentControl, oCCSet As ContentControl, oCCs As ContentControls
Dim varParts As Variant
Dim lngIndex As Long
  Application.ScreenUpdating = False
  varParts = Split(InputBox("Please enter a) a unique set name, b) the number of days to increment each subesequent date," _
                 & " c) the number of incremented dates you need and c) the number of days " & vbCr & vbCr _
                 & "Note - The default format will produce sequential 8 dates incremented 7 days.", "SET DEFINIITON", "Set1|7|8"), "|")
  Set oRng = Selection.Range
  oRng.Collapse wdCollapseStart
  For lngIndex = varParts(2) To 1 Step -1
    With oRng.ContentControls.Add(wdContentControlRichText)
      .Title = varParts(0)
      .Tag = lngIndex
      .SetPlaceholderText , , "Incremented Date"
    End With
    oRng.Text = vbCr
    oRng.Collapse wdCollapseStart
  Next lngIndex
  Set oCC = oRng.ContentControls.Add(wdContentControlDate)
  With oCC
    .Title = "Input"
    .Tag = varParts(0) & "|" & varParts(1)
    .SetPlaceholderText , , "Enter start date and exit"
    .Range.Text = Now
  End With
  'Convert the CC set to Plain Text 'If CCs are inserted with VBA as plain text, you must physically select the redefined range.
  Set oCCs = ActiveDocument.SelectContentControlsByTitle(varParts(0))
  For Each oCCSet In oCCs
    oCCSet.Type = wdContentControlText
  Next oCCSet
  'Call the CC Exit Event
  Document_ContentControlOnExit oCC, False
  Application.ScreenUpdating = True
  Application.ScreenRefresh
lbl_Exit:
  Exit Sub
End Sub