HTSCF Fareha
09-28-2021, 03:33 AM
I'm trying to set some predefined text to a TextBox (txtRationale) if the ComboBox selection value is "PPN1" (sDept variable), but cannot get it to work. If any other ComboBox (sDept variable) selection is made, then the TextBox (txtRationale) should just accept any manually entered value.
(Department1 is the Content Control where the text value populates)
Here's my code with the Bold section where I'm trying to achieve my desired result and hoping that I'm not too far off.
Option Explicit
Sub CreateDoc()
Dim oDoc As Document
Dim myArray() As String
Dim sDept() As String
Dim sBoldList() As String
Dim oRng As Range, oFind As Range
Dim lCount As Long
Dim oVar As Variable
Dim occ As ContentControl
Dim oFrmAssess As THORAssessment
Const sBold As String = "Profile,Profile 2,Profile 3,Profile 4," ' End list with a comma
If ActiveDocument = ThisDocument Then
MsgBox "You cannot use this function to edit the document template", vbCritical
Exit Sub
End If
Set oDoc = ActiveDocument
Set oFrmAssess = New THORAssessment
With oFrmAssess
myArray = Split("- Select -|High|Medium|Low", "|")
sDept = Split("- Select -|Resolution Centre|Local NPT|PPN1|Amberstone|CAT|OMT|CAIT|Team", "|")
.cbThreat.List = myArray
.cbThreat.ListIndex = 0
.cbHarm.List = myArray
.cbHarm.ListIndex = 0
.cbOpportunity.List = myArray
.cbOpportunity.ListIndex = 0
.cbRisk.List = myArray
.cbRisk.ListIndex = 0
.cbDepartment.List = sDept
.cbDepartment.ListIndex = 0
For Each oVar In oDoc.Variables
Select Case oVar.Name
Case "BoldList": .txtBoldList.Text = oVar.Value
Case "Missed": .OptionButton2.Value = oVar.Value
End Select
Next oVar
For Each occ In oDoc.ContentControls
If occ.ShowingPlaceholderText = False Then
Select Case occ.Title
Case "Other"
.txtOther.Text = occ.Range.Text
Case "Research"
.txtResearch.Text = occ.Range.Text
Case "Threat"
.cbThreat.ListIndex = GetLevel(occ)
Case "Threat1"
.txtThreat.Text = occ.Range.Text
Case "Harm"
.cbHarm.ListIndex = GetLevel(occ)
Case "Harm1"
.txtHarm.Text = occ.Range.Text
Case "Opportunity"
.cbOpportunity.ListIndex = GetLevel(occ)
Case "Opportunity1"
.txtOpportunity.Text = occ.Range.Text
Case "Risk"
.cbRisk.ListIndex = GetLevel(occ)
Case "Risk1"
.txtRisk.Text = occ.Range.Text
Case "Department"
.cbDepartment.ListIndex = GetLevel(occ)
If GetLevel(occ) = 3 Then
.txtRationale.Value = "Some predefined text in here"
Else: End If
Case "Department1"
.txtRationale.Text = occ.Range.Text
End Select
End If
Next occ
.Show
If .Tag = 0 Then GoTo lbl_Exit
sBoldList = Split(sBold & .txtBoldList.Text, ",")
oDoc.Variables("BoldList").Value = .txtBoldList.Text
oDoc.Variables("Missed").Value = .OptionButton2.Value
For Each occ In oDoc.ContentControls
Set oRng = occ.Range
oRng.Font.Bold = False
On Error Resume Next
Select Case occ.Title
Case "Other"
oRng.Text = .txtOther.Text
Case "Threat"
oRng.Text = .cbThreat.Value
oRng.Font.Color = .cbThreat.BackColor
Case "Threat1"
oRng.Text = .txtThreat.Text
Case "Harm"
oRng.Text = .cbHarm.Value
oRng.Font.Color = .cbHarm.BackColor
Case "Harm1"
oRng.Text = .txtHarm.Text
Case "Opportunity"
oRng.Text = .cbOpportunity.Value
oRng.Font.Color = .cbOpportunity.BackColor
Case "Opportunity1"
oRng.Text = .txtOpportunity.Text
Case "Risk"
oRng.Text = .cbRisk.Value
oRng.Font.Color = .cbRisk.BackColor
Case "Risk1"
oRng.Text = .txtRisk.Text
Case "Department"
oRng.Text = .cbDepartment.Value
oRng.Font.Bold = True
Case "Department1"
oRng.Text = .txtRationale.Text
Case "Research"
oRng.Text = .txtResearch.Text
oRng.Font.Bold = False
For lCount = 0 To UBound(sBoldList)
Set oFind = occ.Range
With oFind.Find
Do While .Execute(Trim(sBoldList(lCount)))
oFind.Font.Bold = True
oFind.Collapse 0
Loop
End With
Next lCount
End Select
Next occ
End With
lbl_Exit:
Unload oFrmAssess
Set oFrmAssess = Nothing
Set oRng = Nothing
Set oFind = Nothing
Set occ = Nothing
Set oDoc = Nothing
Exit Sub
End Sub
Private Function GetLevel(occ As ContentControl) As Long
Select Case occ.Range.Text
Case "High": GetLevel = 1
Case "Medium": GetLevel = 2
Case "Low": GetLevel = 3
Case "Resolution Centre": GetLevel = 1
Case "Local NPT": GetLevel = 2
Case "PPN1": GetLevel = 3
Case "Amberstone": GetLevel = 4
Case "R&P": GetLevel = 5
Case "CAT": GetLevel = 6
Case "OMT": GetLevel = 7
Case "CAIT": GetLevel = 8
Case "High Harm Team": GetLevel = 9
Case Else: GetLevel = 0
End Select
lbl_Exit:
Exit Function
End Function
Any help would be very much appreciated.
Thanks!
Steve
(Department1 is the Content Control where the text value populates)
Here's my code with the Bold section where I'm trying to achieve my desired result and hoping that I'm not too far off.
Option Explicit
Sub CreateDoc()
Dim oDoc As Document
Dim myArray() As String
Dim sDept() As String
Dim sBoldList() As String
Dim oRng As Range, oFind As Range
Dim lCount As Long
Dim oVar As Variable
Dim occ As ContentControl
Dim oFrmAssess As THORAssessment
Const sBold As String = "Profile,Profile 2,Profile 3,Profile 4," ' End list with a comma
If ActiveDocument = ThisDocument Then
MsgBox "You cannot use this function to edit the document template", vbCritical
Exit Sub
End If
Set oDoc = ActiveDocument
Set oFrmAssess = New THORAssessment
With oFrmAssess
myArray = Split("- Select -|High|Medium|Low", "|")
sDept = Split("- Select -|Resolution Centre|Local NPT|PPN1|Amberstone|CAT|OMT|CAIT|Team", "|")
.cbThreat.List = myArray
.cbThreat.ListIndex = 0
.cbHarm.List = myArray
.cbHarm.ListIndex = 0
.cbOpportunity.List = myArray
.cbOpportunity.ListIndex = 0
.cbRisk.List = myArray
.cbRisk.ListIndex = 0
.cbDepartment.List = sDept
.cbDepartment.ListIndex = 0
For Each oVar In oDoc.Variables
Select Case oVar.Name
Case "BoldList": .txtBoldList.Text = oVar.Value
Case "Missed": .OptionButton2.Value = oVar.Value
End Select
Next oVar
For Each occ In oDoc.ContentControls
If occ.ShowingPlaceholderText = False Then
Select Case occ.Title
Case "Other"
.txtOther.Text = occ.Range.Text
Case "Research"
.txtResearch.Text = occ.Range.Text
Case "Threat"
.cbThreat.ListIndex = GetLevel(occ)
Case "Threat1"
.txtThreat.Text = occ.Range.Text
Case "Harm"
.cbHarm.ListIndex = GetLevel(occ)
Case "Harm1"
.txtHarm.Text = occ.Range.Text
Case "Opportunity"
.cbOpportunity.ListIndex = GetLevel(occ)
Case "Opportunity1"
.txtOpportunity.Text = occ.Range.Text
Case "Risk"
.cbRisk.ListIndex = GetLevel(occ)
Case "Risk1"
.txtRisk.Text = occ.Range.Text
Case "Department"
.cbDepartment.ListIndex = GetLevel(occ)
If GetLevel(occ) = 3 Then
.txtRationale.Value = "Some predefined text in here"
Else: End If
Case "Department1"
.txtRationale.Text = occ.Range.Text
End Select
End If
Next occ
.Show
If .Tag = 0 Then GoTo lbl_Exit
sBoldList = Split(sBold & .txtBoldList.Text, ",")
oDoc.Variables("BoldList").Value = .txtBoldList.Text
oDoc.Variables("Missed").Value = .OptionButton2.Value
For Each occ In oDoc.ContentControls
Set oRng = occ.Range
oRng.Font.Bold = False
On Error Resume Next
Select Case occ.Title
Case "Other"
oRng.Text = .txtOther.Text
Case "Threat"
oRng.Text = .cbThreat.Value
oRng.Font.Color = .cbThreat.BackColor
Case "Threat1"
oRng.Text = .txtThreat.Text
Case "Harm"
oRng.Text = .cbHarm.Value
oRng.Font.Color = .cbHarm.BackColor
Case "Harm1"
oRng.Text = .txtHarm.Text
Case "Opportunity"
oRng.Text = .cbOpportunity.Value
oRng.Font.Color = .cbOpportunity.BackColor
Case "Opportunity1"
oRng.Text = .txtOpportunity.Text
Case "Risk"
oRng.Text = .cbRisk.Value
oRng.Font.Color = .cbRisk.BackColor
Case "Risk1"
oRng.Text = .txtRisk.Text
Case "Department"
oRng.Text = .cbDepartment.Value
oRng.Font.Bold = True
Case "Department1"
oRng.Text = .txtRationale.Text
Case "Research"
oRng.Text = .txtResearch.Text
oRng.Font.Bold = False
For lCount = 0 To UBound(sBoldList)
Set oFind = occ.Range
With oFind.Find
Do While .Execute(Trim(sBoldList(lCount)))
oFind.Font.Bold = True
oFind.Collapse 0
Loop
End With
Next lCount
End Select
Next occ
End With
lbl_Exit:
Unload oFrmAssess
Set oFrmAssess = Nothing
Set oRng = Nothing
Set oFind = Nothing
Set occ = Nothing
Set oDoc = Nothing
Exit Sub
End Sub
Private Function GetLevel(occ As ContentControl) As Long
Select Case occ.Range.Text
Case "High": GetLevel = 1
Case "Medium": GetLevel = 2
Case "Low": GetLevel = 3
Case "Resolution Centre": GetLevel = 1
Case "Local NPT": GetLevel = 2
Case "PPN1": GetLevel = 3
Case "Amberstone": GetLevel = 4
Case "R&P": GetLevel = 5
Case "CAT": GetLevel = 6
Case "OMT": GetLevel = 7
Case "CAIT": GetLevel = 8
Case "High Harm Team": GetLevel = 9
Case Else: GetLevel = 0
End Select
lbl_Exit:
Exit Function
End Function
Any help would be very much appreciated.
Thanks!
Steve