Consulting

Results 1 to 19 of 19

Thread: Change Background Colour Of ComboBox Depending On What Option Is Selected

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

    Change Background Colour Of ComboBox Depending On What Option Is Selected

    I'd really like to add a different colour behind the text in various options of a ComboBox on a UserForm and have them applied to the document behind that word. For example, the word "High" would have a red background.

    The options available are held in two separate arrays like so and are applied when clicking the button named "Enter" :

    Private Sub EnterBut_Click()
    Dim Threat      As Range
        Set Threat = ActiveDocument.Bookmarks("Threat").Range
        Threat.Text = Me.ComboBox1.Value
    
    Dim Risk        As Range
        Set Risk = ActiveDocument.Bookmarks("Risk").Range
        Risk.Text = Me.ComboBox4.Value
    
    Me.Repaint
        UserForm.Hide
    End Sub
    
    
    Private Sub UserForm_initialize()
        Dim myArray()   As String
        'Create list of grades for threat
        myArray = Split("- Select -|High|Medium|Low", "|")
        'Use List method to populate listbox
        ComboBox1.List = myArray
    
    Dim myArray3()  As String
        'Create list of grades for risk
        myArray3 = Split("- Select -|High|Medium|Low", "|")
        'Use List method to populate listbox
        ComboBox4.List = myArray3
    
    lbl_Exit:
        Exit Sub
    End Sub
    For "High" I would like the background colour to be red.
    For "Medium" I would like the background colour to be amber.
    For "Low" I would like the background colour to be green.

    I reckon that the text colour (default is black) of the option will also need to change if the background colour is too dark.

    Thank you!

  2. #2
    This is fairly straightforward

    Option Explicit
    
    Private Sub EnterBut_Click()
    Dim oThreat As Range
    Dim oRisk As Range
        If ComboBox1.ListIndex = 0 Then
            MsgBox "Select threat"
            ComboBox1.SetFocus
            Exit Sub
        End If
        If ComboBox4.ListIndex = 0 Then
            MsgBox "Select risk"
            ComboBox4.SetFocus
            Exit Sub
        End If
        If ActiveDocument.Bookmarks.Exists("Threat") = True Then
            Set oThreat = ActiveDocument.Bookmarks("Threat").Range
            oThreat.Text = ComboBox1.value
            oThreat.Font.Color = ComboBox1.BackColor
            ActiveDocument.Bookmarks.Add "Threat", oThreat
        End If
        If ActiveDocument.Bookmarks.Exists("Risk") = True Then
            Set oRisk = ActiveDocument.Bookmarks("Risk").Range
            oRisk.Text = ComboBox4.value
            oRisk.Font.Color = ComboBox4.BackColor
            ActiveDocument.Bookmarks.Add "Risk", oRisk
        End If
        Set oThreat = Nothing
        Set oRisk = Nothing
        Unload Me
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub ComboBox1_Change()
        With ComboBox1
            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 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
    
    
    Private Sub UserForm_initialize()
    Dim myArray() As String
        'Create list of grades for threat
        myArray = Split("- Select -|High|Medium|Low", "|")
        'Use List method to populate listbox
        ComboBox1.List = myArray
        ComboBox1.ListIndex = 0
        'Use List method to populate listbox
        ComboBox4.List = myArray
        ComboBox4.ListIndex = 0
    lbl_Exit:
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Thanks for this, gmayor. I really appreciate it!

    Unfortunately I get a Compile error: Ambiguous name detected: UserForm_Initialize. This is on the line directly above

    Dim myArray() As String
    If I remove that specific line, I get 'Run-time error "91": Object variable or With block variable not set.

  4. #4
    Ambiguous name detected suggests you have another macro with the same name in the userform.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Ah, yes! Sorted that bit out, thanks! Totally my fault!

    Just a slight problem with this error checking.

    Dim oRisk As Range
        If ComboBox1.ListIndex = 0 Then
            MsgBox "Select threat"
            ComboBox1.SetFocus
            Exit Sub
        End If
        If ComboBox4.ListIndex = 0 Then
            MsgBox "Select risk"
            ComboBox4.SetFocus
            Exit Sub
        End If
        If ActiveDocument.Bookmarks.Exists("Threat") = True Then
            Set oThreat = ActiveDocument.Bookmarks("Threat").Range
            oThreat.Text = ComboBox1.value
            oThreat.Font.Color = ComboBox1.BackColor
            ActiveDocument.Bookmarks.Add "Threat", oThreat
        End If
        If ActiveDocument.Bookmarks.Exists("Risk") = True Then
            Set oRisk = ActiveDocument.Bookmarks("Risk").Range
            oRisk.Text = ComboBox4.value
            oRisk.Font.Color = ComboBox4.BackColor
            ActiveDocument.Bookmarks.Add "Risk", oRisk
        End If
        Set oThreat = Nothing
        Set oRisk = Nothing
        Unload Me
    lbl_Exit:
        Exit Sub
    End Sub
    If an selection is not made, then the box pops up to prompt. All good so far.
    However, clicking "Okay" on the prompt box then continues to process the form without anything being entered.

  6. #6
    The code
    If ComboBox1.ListIndex = 0 Then
            MsgBox "Select threat"
            ComboBox1.SetFocus
            Exit Sub
        End If
    selects the errant combobox and exits the sub when nothing has been selected. The code I provided should not continue the process past Exit Sub.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Sorry for the slow response, for some reason VBA Express wouldn't load for me.


    The UserForm just disappears when you click "Okay".

  8. #8
    VBA Express has been temperamental for a few weeks.
    Can you post the template?
    It should run when you click the button called 'EnterBut'
    If you have selected the two combobox values and you have the two named bookmarks in the document, it should disappear and update the bookmarks. If the bookmarks are missing it does nothing.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Thanks, gmayor.

    Here is the entire code for the form.

    'Cancel button
    Private Sub CancelBut_Click()
        UserForm.Hide
    End Sub
    'Reset button
    Private Sub ResetBut_Click()
        Dim ctl         As MSForms.Control
        
        For Each ctl In Me.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
    
    'Copy button
    Private Sub CopyButton1_Click()
        Selection.WholeStory        'Select whole document
        Selection.Copy        'Copy the selection
        
        Dim ctl         As MSForms.Control
        
        For Each ctl In Me.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
        UserForm.Hide
    End Sub
    
    'Provide option of adding further occurrences
    Option Explicit
    OptionButton1.Value = True
    End Sub
    
    Private Sub OptionButton1_Change()
        If OptionButton1.Value = True Then
            TextBox2.Visible = False
            TextBox2.Text = "None."
        Else
            TextBox2.Visible = True
            TextBox2.Text = ""
        End If
    End Sub
    
    Private Sub CommandButton1_Click()
        Dim oRng        As Range
        If ActiveDocument.Bookmarks.Exists("Other") = True Then
            Set oRng = ActiveDocument.Bookmarks("Other").Range
            oRng.Text = TextBox2.Text
            oRng.Bookmarks.Add "Other"
        End If
        Unload Me
    End Sub
    
    'Enter button
    Option Explicit
    Private Sub EnterBut_Click()
        Dim Occurrence     As Range
        Set Occurrence = ActiveDocument.Bookmarks("Occurrence").Range
        Occurrence.Text = Me.TextBox1.Value
        
        Dim Other  As Range
        Set Other = ActiveDocument.Bookmarks("Other").Range
        Other.Text = Me.TextBox2.Value
        
        Dim Research    As Range
        Set Research = ActiveDocument.Bookmarks("Research").Range
        Research.Text = Me.TextBox3.Value
        
        Dim Threat1     As Range
        Set Threat1 = ActiveDocument.Bookmarks("Threat1").Range
        Threat1.Text = Me.TextBox4.Value
        
        Dim Harm1       As Range
        Set Harm1 = ActiveDocument.Bookmarks("Harm1").Range
        Harm1.Text = Me.TextBox5.Value
        
        Dim Opportunity1 As Range
        Set Opportunity1 = ActiveDocument.Bookmarks("Opportunity1").Range
        Opportunity1.Text = Me.TextBox6.Value
        
        Dim Risk1       As Range
        Set Risk1 = ActiveDocument.Bookmarks("Risk1").Range
        Risk1.Text = Me.TextBox7.Value
        
        Dim Department1 As Range
        Set Department1 = ActiveDocument.Bookmarks("Department1").Range
        Department1.Text = Me.TextBox8.Value
        
        Me.Repaint
        UserForm.Hide
        
        Dim oThreat         As Range
        Dim oHarm           As Range
        Dim oOpportunity    As Range
        Dim oRisk           As Range
        Dim oDepartment     As Range
        
        If ComboBox1.ListIndex = 0 Then
            MsgBox "Select threat"
            ComboBox1.SetFocus
            Exit Sub
        End If
        
        If ComboBox2.ListIndex = 0 Then
            MsgBox "Select harm"
            ComboBox2.SetFocus
            Exit Sub
        End If
        
        If ComboBox3.ListIndex = 0 Then
            MsgBox "Select opportunity"
            ComboBox3.SetFocus
            Exit Sub
        End If
        
        If ComboBox4.ListIndex = 0 Then
            MsgBox "Select risk"
            ComboBox4.SetFocus
            Exit Sub
        End If
        
        If ComboBox5.ListIndex = 0 Then
            MsgBox "Select department"
            ComboBox5.SetFocus
            Exit Sub
        End If
        
        If ActiveDocument.Bookmarks.Exists("Threat") = True Then
            Set oThreat = ActiveDocument.Bookmarks("Threat").Range
            oThreat.Text = ComboBox1.Value
            oThreat.Font.Color = ComboBox1.BackColor
            ActiveDocument.Bookmarks.Add "Threat", oThreat
        End If
        
        If ActiveDocument.Bookmarks.Exists("Harm") = True Then
            Set oHarm = ActiveDocument.Bookmarks("Harm").Range
            oHarm.Text = ComboBox2.Value
            oHarm.Font.Color = ComboBox2.BackColor
            ActiveDocument.Bookmarks.Add "Harm", oHarm
        End If
        
        If ActiveDocument.Bookmarks.Exists("Opportunity") = True Then
            Set oOpportunity = ActiveDocument.Bookmarks("Opportunity").Range
            oOpportunity.Text = ComboBox3.Value
            oOpportunity.Font.Color = ComboBox3.BackColor
            ActiveDocument.Bookmarks.Add "Opportunity", oOpportunity
        End If
        
        If ActiveDocument.Bookmarks.Exists("Risk") = True Then
            Set oRisk = ActiveDocument.Bookmarks("Risk").Range
            oRisk.Text = ComboBox4.Value
            oRisk.Font.Color = ComboBox4.BackColor
            ActiveDocument.Bookmarks.Add "Risk", oRisk
        End If
        
        If ActiveDocument.Bookmarks.Exists("Department") = True Then
            Set oDepartment = ActiveDocument.Bookmarks("Department").Range
            oDepartment.Text = ComboBox5.Value
            ActiveDocument.Bookmarks.Add "Department", oDepartment
        End If
        
        Set oThreat = Nothing
        Set oHarm = Nothing
        Set oOpportunity = Nothing
        Set oRisk = Nothing
        Set oDepartment = Nothing
        Unload Me
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub ComboBox1_Change()
        With ComboBox1
            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 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
    
    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
    
    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
    
    Private Sub UserForm_initialize()
        Dim myArray()   As String
        'Create list of grades for threat
        myArray = Split("- Select -|High|Medium|Low", "|")
        'Use List method to populate listbox
        ComboBox1.List = myArray
        ComboBox1.ListIndex = 0
        '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
        
        Dim myArray1()  As String
        'Create list for departments
        myArray1 = Split("- Select -|Resolution Centre|Local|PPN1|Amberstone|Collision Assessment", "|")
        'Use List method to populate listbox
        ComboBox5.List = myArray1
        ComboBox5.ListIndex = 0
    lbl_Exit:
        Exit Sub
    End Sub
    The only other question that I have regarding this form, although technically not linked to this thread, is to do with the copy button function. I found this piece of code online somewhere and was wondering if this will capture the entire content of the document, including all the formating or does the enter button have to be pressed first?

    Thanks again for your time, this is really helping me. I'm new to VBA so am still trying to get my head around it. Although when looking through your replies, I can immediately see the logic.

  10. #10
    There are some deliberate mistakes and some overkill in your code. Note Option Explicit only ever goes (once) at the top of the module and is there to force you to declare variables used in the code. You can set it automatically in new modules from the VBA editor Tools > Options.

    I have added a function from my web site to fill bookmarks rather than set them separately.

    I have no idea what you are trying to achieve with the CommandButton1, Copy and Reset buttons. You can set initial values of controls with the UserForm_initialize sub. The code should be in a template from which new documents are created.

    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
    
    'Copy button
    'What is this supposed to achieve?
    Private Sub CopyButton1_Click()
    Selection.WholeStory        'Select whole document
    Selection.Copy        'Copy the selection
    
    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
        UserForm1.Hide
    End Sub
    
    Private Sub OptionButton1_Change()
        If OptionButton1.value = True Then
            TextBox2.Visible = False
            TextBox2.Text = "None."
        Else
            TextBox2.Visible = True
            TextBox2.Text = ""
        End If
    End Sub
    
    Private Sub CommandButton1_Click()    'Why this button?
    Dim oRng As Range
        If ActiveDocument.Bookmarks.Exists("Other") = True Then
            Set oRng = ActiveDocument.Bookmarks("Other").Range
            oRng.Text = TextBox2.Text
            oRng.Bookmarks.Add "Other"
        End If
        Unload Me
    End Sub
    
    'Enter button
    'Option Explicit 'This only ever goes at the top of the module
    Private Sub EnterBut_Click()
    Dim oThreat As Range, oHarm As Range, oOpportunity As Range
    Dim oRisk As Range, oDepartment As Range
    
        'check required fields are filled first ... what about checking that the text boxes are filled also?
    
        If ComboBox1.ListIndex = 0 Then
            MsgBox "Select threat"
            ComboBox1.SetFocus
            Exit Sub
        End If
    
        If ComboBox2.ListIndex = 0 Then
            MsgBox "Select harm"
            ComboBox2.SetFocus
            Exit Sub
        End If
    
        If ComboBox3.ListIndex = 0 Then
            MsgBox "Select opportunity"
            ComboBox3.SetFocus
            Exit Sub
        End If
    
        If ComboBox4.ListIndex = 0 Then
            MsgBox "Select risk"
            ComboBox4.SetFocus
            Exit Sub
        End If
    
        If ComboBox5.ListIndex = 0 Then
            MsgBox "Select department"
            ComboBox5.SetFocus
            Exit Sub
        End If
    
        'use FillBM function to write to bookmarks
        FillBM "Occurrence", TextBox1.Text
        FillBM "Other", TextBox2.Text
        FillBM "Research", TextBox3.Text
        FillBM "Threat1", TextBox4.Text
        FillBM "Harm1", TextBox5.Text
        FillBM "Opportunity", TextBox6.Text
        FillBM "Risk1", TextBox7.Text
        FillBM "Department1", TextBox8.Text
    
        'Or process the bookmarks individually
        If ActiveDocument.Bookmarks.Exists("Threat") = True Then
            Set oThreat = ActiveDocument.Bookmarks("Threat").Range
            oThreat.Text = ComboBox1.value
            oThreat.Font.Color = ComboBox1.BackColor
            ActiveDocument.Bookmarks.Add "Threat", oThreat
        End If
    
        If ActiveDocument.Bookmarks.Exists("Harm") = True Then
            Set oHarm = ActiveDocument.Bookmarks("Harm").Range
            oHarm.Text = ComboBox2.value
            oHarm.Font.Color = ComboBox2.BackColor
            ActiveDocument.Bookmarks.Add "Harm", oHarm
        End If
    
        If ActiveDocument.Bookmarks.Exists("Opportunity") = True Then
            Set oOpportunity = ActiveDocument.Bookmarks("Opportunity").Range
            oOpportunity.Text = ComboBox3.value
            oOpportunity.Font.Color = ComboBox3.BackColor
            ActiveDocument.Bookmarks.Add "Opportunity", oOpportunity
        End If
    
        If ActiveDocument.Bookmarks.Exists("Risk") = True Then
            Set oRisk = ActiveDocument.Bookmarks("Risk").Range
            oRisk.Text = ComboBox4.value
            oRisk.Font.Color = ComboBox4.BackColor
            ActiveDocument.Bookmarks.Add "Risk", oRisk
        End If
    
        If ActiveDocument.Bookmarks.Exists("Department") = True Then
            Set oDepartment = ActiveDocument.Bookmarks("Department").Range
            oDepartment.Text = ComboBox5.value
            ActiveDocument.Bookmarks.Add "Department", oDepartment
        End If
    
        Set oThreat = Nothing
        Set oHarm = Nothing
        Set oOpportunity = Nothing
        Set oRisk = Nothing
        Set oDepartment = Nothing
        Unload Me
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub ComboBox1_Change()
        With ComboBox1
            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 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
    
    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
    
    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
    
    Private Sub UserForm_initialize()
    Dim myArray() As String
        'Create list of grades for threat
        myArray = Split("- Select -|High|Medium|Low", "|")
        'Use List method to populate listbox
        ComboBox1.List = myArray
        ComboBox1.ListIndex = 0
        '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
    
        'Redefine list for departments
        myArray = Split("- Select -|Resolution Centre|Local|PPN1|Amberstone|Collision Assessment", "|")
        'Use List method to populate listbox
        ComboBox5.List = myArray
        ComboBox5.ListIndex = 0
        OptionButton1.value = True
    lbl_Exit:
        Exit Sub
    End Sub
    
    
    Public Sub FillBM(strbmName As String, strValue As String)
    '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.Bookmarks.Add strbmName
            End If
        End With
    lbl_Exit:
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Thinking about it, I'm not sure why I needed the copy button! Okay, that code has been removed.

    CommandButton1 was from an earlier query - How Do I Set A Default Variable For An OptionButton

    Everything seems to be working okay, except that the above bit is no longer working (this is what the above query was for). It should show "None." if the option is set to "no", but enter the text contained in TextBox2 if option is "yes". If you click "yes", the textbox appears as it should. But if you then change your mind and select "no", the UserForm enters whatever has been input elsewhere, regardless of what option was selected..

    Thanks!
    Last edited by HTSCF Fareha; 08-08-2020 at 10:30 AM.

  12. #12
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Thinking about it, I'm not sure why I needed the copy button! Okay, that code has been removed.

    CommandButton1 was from an earlier query - How Do I Set A Default Variable For An OptionButton

    Everything seems to be working okay, except that the above bit is no longer working (this is what the above query was for). It should show "None." if the option is set to "no", but enter the text contained in TextBox2 if option is "yes". If you click "yes", the textbox appears as it should and everything is okay. But if you then change your mind and select "no" or leave it as "no", the Bookmark is not actioned with either "None" or "what ever has been typed".

    Thanks!
    Last edited by HTSCF Fareha; 08-08-2020 at 11:23 AM.

  13. #13
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Just a small point - which is the most efficient method?

    'use FillBM function to write to bookmarks
        FillBM "Occurrence", TextBox1.Text
        FillBM "Other", TextBox2.Text
        FillBM "Research", TextBox3.Text
        FillBM "Threat1", TextBox4.Text
        FillBM "Harm1", TextBox5.Text
        FillBM "Opportunity", TextBox6.Text
        FillBM "Risk1", TextBox7.Text
        FillBM "Department1", TextBox8.Text
    
        'Or process the bookmarks individually
        If ActiveDocument.Bookmarks.Exists("Threat") = True Then
            Set oThreat = ActiveDocument.Bookmarks("Threat").Range
            oThreat.Text = ComboBox1.value
            oThreat.Font.Color = ComboBox1.BackColor
            ActiveDocument.Bookmarks.Add "Threat", oThreat
        End If

  14. #14
    The function uses fewer lines of code to achieve the same result. Functions are commonly used to avoid repetition.

    CommandButton1 seems superfluous also as the Enter button fills the bookmarks, including the 'Other' bookmark with whatever is in TextBox2

    The initial value of optionbutton1 is set in the UserForm_initialize sub along with any other initial values. You could use this sub to read the existing values from any of the bookmarks into the controls if you wished.

    You don't need a default variable for the option button, you can simply read its value and set the result accordingly. Currently the code associated with the option button is as follows.

    Private Sub OptionButton1_Change()     
    If OptionButton1.value = True Then
            TextBox2.Visible = False
            TextBox2.Text = "None."
        Else
            TextBox2.Visible = True
            TextBox2.Text = ""
        End If
    End Sub
    The textbox 'displays' nothing if visible 'None.' if invisible.
    The code doesn't change the bookmark content. That is effected by the enter button
    Last edited by gmayor; 08-09-2020 at 12:40 AM.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  15. #15
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Ah, I understand the preference of a function now. Fewer lines = faster execution = less overhead.

    I forgot to mention that I had already removed the CommandButton1 as I could see that it was superfluous.

    I don't think I explained my problem with the OptionButton1 clearly enough.

    If you complete the rest of the form and leave the Optionbutton1 in its default 'none' position, when "Enter" is pressed, the value 'None.' is not populated at the bookmark. Try the same thing again, but this time click OptionButton1 to "yes' (true), then back to "None." (false), complete the rest of the form as before, then press "Enter", the bookmark is correctly shown on the document as "None.".

  16. #16
    Add the line below to Userform_Initialize
    TextBox2.Text = "None."
    before lbl_Exit:
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  17. #17
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Fabulous! Works like a dream, thank you!

    If ActiveDocument.Bookmarks.Exists("Threat") = True Then
            Set oThreat = ActiveDocument.Bookmarks("Threat").Range
            oThreat.Text = ComboBox1.Value
            oThreat.Font.Color = ComboBox1.BackColor
            ActiveDocument.Bookmarks.Add "Threat", oThreat
        End If
    Can I add "Threat" (and other Bookmarks) to FillBM, keeping the colour option, or will the syntax change slightly from that for the TextBox?

  18. #18
    The syntax would have to change, but the easiest way to do that would be to add the colour selection to the FillBM function e.g.
    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
    For those bookmarks for which you want to set the color you can add the colour to the function call e.g.
    FillBM "Threat", ComboBox1.value, ComboBox1.BackColor
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  19. #19
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Brilliant, simply brilliant! Thank you.

Tags for this Thread

Posting Permissions

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