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