Search code examples
vbams-wordword-contentcontrolrowdeleting

Word- VBA- How To Prevent Deletion of Selected Repeating Section Content Controls If There Is Only One Section Remaining?


The following code successfully deletes the selected RSCC but always prevents the first RSCC from being deleted.

 Dim cc As ContentControl
    If Selection.Information(wdInContentControl) Then
        Set cc = Selection.ParentContentControl
        If Not cc.Type = wdContentControlRepeatingSection Then
            Do Until cc.Type = wdContentControlRepeatingSection
                Set cc = cc.ParentContentControl
            Loop
        End If
        Dim index As Long
        For index = 1 To cc.RepeatingSectionItems.Count
            If Selection.Range.InRange(cc.RepeatingSectionItems(index).Range) Then
                If index > 1 Then
                    cc.RepeatingSectionItems(index).Delete
                Else
                    MsgBox Prompt:="You cannot delete this.", Title:="Error"
                End If
                Exit For
            End If
        Next index
    End If

My goal is to be able to delete any selected RSCC but not if there is any one RSCC remaining.

In other words, if I have three RSCCs (1,2,3), instead of always protecting section 1, I would like to protect section 2 if I were to delete the section 1 and 3 or protect section 3 if section 1 and 2 were deleted.


Solution

  •    Dim cc As ContentControl
       If Selection.Information(wdInContentControl) Then
          Set cc = Selection.ParentContentControl
          If Not cc.Type = wdContentControlRepeatingSection Then
             Do Until cc.Type = wdContentControlRepeatingSection
                Set cc = cc.ParentContentControl
             Loop
          End If
          If cc.RepeatingSectionItems.count > 1 Then
             Dim index As Long
             Dim count As Long
             count = cc.RepeatingSectionItems.count
             For index = cc.RepeatingSectionItems.count To 1 Step -1
                If Selection.Range.InRange(cc.RepeatingSectionItems(index).Range) Then
                   If count > 1 Then
                      cc.RepeatingSectionItems(index).Delete
                      count = count - 1
                   Else
                      MsgBox Prompt:="There is only 1 item left so you cannot delete it.", Title:="Error"
                   End If
                End If
             Next index
          Else
             MsgBox Prompt:="There is only 1 item left so you cannot delete it.", Title:="Error"
          End If
       End If