Consulting

Results 1 to 2 of 2

Thread: Set TextBox content based on selected ComboBox value

  1. #1
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location

    Set TextBox content based on selected ComboBox value

    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

  2. #2
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Sorry, posted this in haste - Please ignore!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •