Option Explicit
'Cancel button
Private Sub CancelBut_Click()
Unload Me
End Sub
'Reset button
Private Sub ResetBut_Click()
Dim ctl As MSForms.Control
For Each ctl In Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButton"
ctl.Value = True
Case "ComboBox", "ListBox"
ctl.ListIndex = 0
End Select
Next ctl
End Sub
'Enter button
Private Sub EnterBut_Click()
Dim oThreat As Range, oHarm As Range, oOpportunity As Range
Dim oRisk As Range, oReview As Range, oReason As Range
'Check required fields are filled out
If TextBox1.Text = "" Then
MsgBox "Provide Review", vbCritical, "Triage Hub"
TextBox1.SetFocus
Exit Sub
End If
If TextBox2.Text = "" Then
MsgBox "Provide Reason", vbCritical, "Triage Hub"
TextBox2.SetFocus
Exit Sub
End If
If ComboBox2.ListIndex = 0 Then
MsgBox "Select threat level", vbCritical, "Triage Hub"
ComboBox2.SetFocus
Exit Sub
End If
If ComboBox3.ListIndex = 0 Then
MsgBox "Select harm level", vbCritical, "Triage Hub"
ComboBox3.SetFocus
Exit Sub
End If
If ComboBox4.ListIndex = 0 Then
MsgBox "Select opportunity level", vbCritical, "Triage Hub"
ComboBox4.SetFocus
Exit Sub
End If
If ComboBox5.ListIndex = 0 Then
MsgBox "Select risk level", vbCritical, "Triage Hub"
ComboBox5.SetFocus
Exit Sub
End If
'use FillBM function to write to bookmarks
FillBM "Review", TextBox1.Text
FillBM "Reason", TextBox2.Text
FillBM "Threat1", TextBox3.Text
FillBM "Harm1", TextBox4.Text
FillBM "Opportunity1", TextBox5.Text
FillBM "Risk1", TextBox6.Text
FillBM "Threat", ComboBox2.Value, ComboBox2.BackColor
FillBM "Harm", ComboBox3.Value, ComboBox3.BackColor
FillBM "Opportunity", ComboBox4.Value, ComboBox4.BackColor
FillBM "Risk", ComboBox5.Value, ComboBox5.BackColor
Set oThreat = Nothing
Set oHarm = Nothing
Set oOpportunity = Nothing
Set oRisk = Nothing
Set oReason = Nothing
Set oReview = Nothing
Unload Me
lbl_Exit:
Exit Sub
End Sub
'Change colour of dropdown
Private Sub ComboBox2_Change()
With ComboBox2
Select Case .ListIndex
Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
End Select
End With
lbl_Exit:
Exit Sub
End Sub
'Change colour of dropdown
Private Sub ComboBox3_Change()
With ComboBox3
Select Case .ListIndex
Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
End Select
End With
lbl_Exit:
Exit Sub
End Sub
'Change colour of dropdown
Private Sub ComboBox4_Change()
With ComboBox4
Select Case .ListIndex
Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
End Select
End With
lbl_Exit:
Exit Sub
End Sub
'Change colour of dropdown
Private Sub ComboBox5_Change()
With ComboBox5
Select Case .ListIndex
Case 0: .BackColor = &H80000005: .ForeColor = &H80000008
Case 1: .BackColor = &HFF&: .ForeColor = &H80000005
Case 2: .BackColor = &H80FF&: .ForeColor = &H80000005
Case 3: .BackColor = &H8000&: .ForeColor = &H80000005
End Select
End With
lbl_Exit:
Exit Sub
End Sub
Private Sub ListBox1_Change()
Dim arrSelected() As String
Dim lngIndex As Long
Dim lngDem As Long
lngDem = 0
For lngIndex = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(lngIndex) = True Then
'Dimension the array
ReDim Preserve arrSelected(lngDem)
lngDem = lngDem + 1
Select Case ListBox1.List(lngIndex)
'If item is selected then add to array.
Case "Requires further investigation":
arrSelected(UBound(arrSelected)) = "Lorem ipsum dolor sit amet, consectetur adipiscing elit. In rhoncus, lorem et fringilla dictum, orci orci posuere lacus, ut auctor libero neque non purus. Fusce a commodo ligula."
Case "Urgent review":
arrSelected(UBound(arrSelected)) = "Proin sed nisl enim. Cras in nisl tempus, scelerisque mi id, vulputate arcu. Duis nec mi ac lorem pretium semper."
Case "Manageable risk":
arrSelected(UBound(arrSelected)) = "Fusce eu nisi sollicitudin, pharetra nibh sed, vestibulum neque. Praesent a auctor turpis. Mauris posuere vitae justo ac mollis."
Case "For Noting Only":
arrSelected(UBound(arrSelected)) = "Sed eu eros ipsum. Ut posuere id magna eu sollicitudin. Nunc suscipit tempor egestas. Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos himenaeos."
Case Else
arrSelected(UBound(arrSelected)) = ""
End Select
End If
Next lngIndex
If fcnIsArrayAllocated(arrSelected) Then
'If array dimensioned then develop string.
TextBox2.Text = fcnArrayToSepPars(arrSelected)
Else
TextBox2.Text = vbNullString
End If
lbl_Exit:
Exit Sub
End Sub
Private Sub UserForm_initialize()
With TextBox2
.MultiLine = True
.ScrollBars = fmScrollBarsVertical
End With
ListBox1.List = Split("- Select One Or More -|Requires further investigation|Urgent review|" _
& "Manageable risk|For Noting Only", "|")
lbl_Exit:
Exit Sub
End Sub
Function fcnIsArrayAllocated(arrPassed As Variant) As Boolean
'Adapted from method published by Chip Pearson.
On Error Resume Next
fcnIsArrayAllocated = IsArray(arrPassed) And Not IsError(LBound(arrPassed, 1)) And LBound(arrPassed, 1) <= UBound(arrPassed, 1)
lbl_Exit:
Exit Function
End Function
Public Function fcnArrayToSepPars(varIn As Variant) As String
Dim strTemp As String
Dim lngIndex As Long
Select Case UBound(varIn)
Case 0: fcnArrayToSepPars = varIn(0)
Case Else
fcnArrayToSepPars = varIn(0)
lngIndex = 0
Do While lngIndex < UBound(varIn)
fcnArrayToSepPars = fcnArrayToSepPars & vbCr & vbCr & varIn(lngIndex)
lngIndex = lngIndex + 1
Loop
End Select
lbl_Exit:
Exit Function
End Function
Dim myArray() As String
'Redefine list for reason for threat level
'Select threat level
'Create list of grades for threat
myArray = Split("- Select -|High|Medium|Low", "|")
'Use List method to populate listbox
ComboBox2.List = myArray
ComboBox2.ListIndex = 0
'Use List method to populate listbox
ComboBox3.List = myArray
ComboBox3.ListIndex = 0
'Use List method to populate listbox
ComboBox4.List = myArray
ComboBox4.ListIndex = 0
'Use List method to populate listbox
ComboBox5.List = myArray
ComboBox5.ListIndex = 0
lbl_Exit:
Exit Sub
End Sub
Private Sub FillBM(strbmName As String, strValue As String, Optional lngColor As Long = &H80000005)
'Graham Mayor - http://www.gmayor.com
Dim oRng As Range
With ActiveDocument
On Error GoTo lbl_Exit
If .Bookmarks.Exists(strbmName) = True Then
Set oRng = .Bookmarks(strbmName).Range
oRng.Text = strValue
oRng.Font.Color = lngColor
oRng.Bookmarks.Add strbmName
End If
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub
Reply With Quote