Nested Repeating Content Control Code not working

26 views Asked by At

I have a table in word which requires a content control box (task step) to be selected, this then populates the next content control box (hazard) with an individualized list, and dependant on the selection, populates a third content control (control measure).

I am trying to then add a new row which includes empty content control boxes - however currently the new row is added but the hazard and control field are already populated with the previous fields selection. Could anybody help with what I am missing from the code please?

however currently the new row is added but the hazard and control field are already populated with the previous fields selection. Could anybody help with what I am missing from the code please?

Option Explicit
Dim StrOption As String
Private Sub Document_ContentControlOnEnter(ByVal CCtrl As ContentControl)
If CCtrl.Tag = "Line" Then StrOption = CCtrl.Range.Text
End Sub
'Section to Populate Plant Area drop down dependant on Line input
Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
Dim i As Long, StrOut As String, j As Long, Prot As Variant
'Section to enter new rows in RA field
Const StrBkMk As String = "TblBkMk"
Const Pwd As String = "Sherburn1."
With ActiveDocument
    If .Bookmarks.Exists(StrBkMk) = False Then
    MsgBox "The table bookmark: '" & StrBkMk & "' is missing." & vbCr & _
    "Please add it to the relevant table before continuing.", vbExclamation
    Exit Sub
  End If
End With
With CCtrl
   If .Range.InRange(ActiveDocument.Bookmarks(StrBkMk).Range) = False Then Exit Sub
   i = .Range.Tables(1).Range.ContentControls.Count
   j = ActiveDocument.Range(.Range.Tables(1).Range.Start, .Range.End).ContentControls.Count
   If i <> j Then Exit Sub
End With
If MsgBox("Add new row?", vbQuestion + vbYesNo) <> vbYes Then Exit Sub
With ActiveDocument
   Prot = .ProtectionType
   If .ProtectionType <> wdNoProtection Then
   Prot = .ProtectionType
    .Unprotect Password:=Pwd
   End If
   With Selection.Tables(1).Rows
     With .Last.Range
      .Next.InsertBefore vbCr
      .Next.FormattedText = .FormattedText
     End With
     Selection.Tables(1).Range.Bookmarks.Add (StrBkMk)
     For Each CCtrl In .Last.Range.ContentControls
      With CCtrl
        If .Type = wdContentControlCheckBox Then .Checked = False
        If .Type = wdContentControlRichText Or .Type = wdContentControlText Then .Range.Text = ""
        If .Type = wdContentControlDropdownList Then .DropdownListEntries(1).Select
        If .Type = wdContentControlComboBox Then .DropdownListEntries(1).Select
        If .Type = wdContentControlDate Then .Range.Text = ""
      End With
     Next
   End With
   .Protect Type:=Prot, Password:=Pwd
End With
With CCtrl
   If .Tag = "Line" Then
    If StrOption = .Range.Text Then Exit Sub
    Select Case .Range.Text
      Case "Common Areas"
        StrOut = "Scrap Plant,Rock Infeed,Rock Shed,Rock Outfeed,Cage Mill,Rock Grinding,Dry Mineral,Calcination,Stucco"
      Case "GRG"
        StrOut = "Tissue,Dry Additives,Wet Additives,Mixer,Forming,Cutter,Wet End Transfer,Dryer,Dry Transfer,Trimming,Stacking,Palletiser"
    Case "BP2"
        StrOut = "Paper,Dry Additives,Wet Additives,Mixer,Forming Station,Cutter,Wet End Transfer,Dryer,Outfeed,Dry Transfer,Saws,Stacking,Palletising,FLT,Aux Equipment"
      Case "Cove"
        StrOut = "Paper,Dry Additives,Wet Additives,Mixer,Forming,Cutter,Wet End Transfer,Dryer,Dry Transfer,Shrinkwrap,Boxing,Palletiser"
      Case Else
        .Type = wdContentControlText
        .Range.Text = ""
        .Type = wdContentControlDropdownList
    End Select
    With ActiveDocument.SelectContentControlsByTag("Plant Area")(1)
      .DropdownListEntries.Clear
      For i = 0 To UBound(Split(StrOut, ","))
        .DropdownListEntries.Add Split(StrOut, ",")(i)
      Next
      .Type = wdContentControlText
      .Range.Text = ""
      .Type = wdContentControlDropdownList
    End With
   End If
   'Section to populate Hazard selection based on Task Step selection
   If .Tag = "Task Step" Then
   If StrOption = .Range.Text Then Exit Sub
    Select Case .Range.Text
      Case "Access"
        StrOut = "Overhead hazards - Impact injuries,Noise - Hearing damage/loss,Poor Visibility - Slips trips & falls/Contact with stationary objects"
      Case "Maintenance Tasks"
        StrOut = "Moving Machinery - Entrapment/Crush Injuries,Gas Systems - Fire & Explosion,Manual Handling - Musculoskeletal Injuries"
      Case Else
        .Type = wdContentControlText
        .Range.Text = ""
        .Type = wdContentControlDropdownList
    End Select
    With ActiveDocument.SelectContentControlsByTag("Hazard")(1)
      .DropdownListEntries.Clear
      For i = 0 To UBound(Split(StrOut, ","))
        .DropdownListEntries.Add Split(StrOut, ",")(i)
      Next
      .Type = wdContentControlText
      .Range.Text = ""
      .Type = wdContentControlDropdownList
    End With
  End If
  'Section to populate Control measures based on Hazard selection
  If .Tag = "Hazard" Then
    If StrOption = .Range.Text Then Exit Sub
    Select Case .Range.Text
      Case "Overhead hazards - Impact injuries"
        StrOut = "Hard hat or Bump cap to be worn at all times"
      Case "Noise - Hearing damage/loss"
        StrOut = "Ear protection to be worn at all times"
      Case "Poor Visibility - Slips trips & falls/Contact with stationary objects"
        StrOut = "Moving Machinery - Entrapment/Crush Injuries,Gas Systems - Fire & Explosion,Manual Handling - Musculoskeletal Injuries"
      Case "Moving Machinery - Entrapment/Crush Injuries"
        StrOut = "Isolate as per Isolation Procedure in accordance with LOTO procedures,Isolate as per LOTO Assessment in accordance with LOTO procedures"
      Case "Gas Systems - Fire & Explosion"
        StrOut = "Isolate & purge gas systems as per Isolation Procedure in accordnace with LOTO procedures"
      Case "Manual Handling - Musculoskeletal Injuries"
        StrOut = "Use lifting aids where available. Trained Personnel. Use Good Techniques. Do not exceed personal capacity"
      Case Else
        .Type = wdContentControlText
        .Range.Text = ""
        .Type = wdContentControlDropdownList
    End Select
    With ActiveDocument.SelectContentControlsByTag("Control Measure")(1)
      .DropdownListEntries.Clear
      For i = 0 To UBound(Split(StrOut, ","))
        .DropdownListEntries.Add Split(StrOut, ",")(i)
      Next
      .Type = wdContentControlText
      .Range.Text = ""
      .Type = wdContentControlDropdownList
    End With
  End If
  'Section to highlight Maintenance type & Frequency text when checkbox ticked
  Dim sName As String, lColour As Long
  If CCtrl.Type = wdContentControlCheckBox Then
    If CCtrl.Checked Then
      lColour = wdYellow
    Else
      lColour = wdNoHighlight
    End If
    sName = Replace(CCtrl.Title, " ", "")
    If ActiveDocument.Bookmarks.Exists(sName) Then
      ActiveDocument.Bookmarks(sName).Range.HighlightColorIndex = lColour
    End If
  End If
End With
End Sub
0

There are 0 answers