How to change the picture in a userform if clicked

Question

I am trying to change a picture in a userform to an "active format" when it is clicked and then when another picture is clicked the picture that was previously clicked goes back to a "dormant format" and the new picture that has been clicked is now an "active format". This is to show the user which menu they are currently on.

I have been trying to use the following code to do this but I cannot seem to get the pictures to return to the "dormant format" when the other picture is clicked. The code is also very lengthy so if there are an suggestions on how to reduce the length that would be helpful as I have 8 menus in the userform.

    '----------------------------------------------------------Menu 0 Button
Private Sub Home_Bttn_Click()

 Home.MultiPage1.Value = 0

 If Home.MultiPage1.Value = 0 Then

    Home_Bttn.SpecialEffect = fmSpecialEffectRaised

    '----------------------------------------------------------Changing button to active and setting others to Dormant
    'Activated
    Home_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Activated\Home_Bttn_Activated.jpg")
    'Dormant
    Create_Protocol_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Create_Summary_Report_Bttn_Dormant.jpg")
    Create_Summary_Report_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Create_Summary_Report_Bttn_Dormant.jpg")
    Review_Summary_Report_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Review_Summary_Report_Bttn_Dormant.jpg")
    Add_Report_Template_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Add_Report_Template_Bttn_Dormant.jpg")
    Add_Calbration_Certificates_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Add_Calbration_Certificates_Bttn_Dormant.jpg")
    Add_to_Database_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Add_to_Database_Bttn_Dormant.jpg")
    User_Agreement_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\User_Agreement_Bttn_Dormant.jpg")
    Email_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Email_Bttn_Dormant.jpg")
    Mobile_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Mobile_Bttn_Dormant.jpg")
    'Title
    Menu_Title.Caption = "Home"    
 End If    
End Sub

'----------------------------------------------------------Menu 1 Button
Private Sub Create_Protocol_Bttn_Click()

 Home.MultiPage1.Value = 1

 If Home.MultiPage1.Value = 1 Then

     Create_Protocol_Bttn.SpecialEffect = fmSpecialEffectRaised

     '----------------------------------------------------------Changing button to active and setting others to Dormant
     'Activated
     Create_Protocol_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Activated\Create_Protocol_Bttn_Activated.jpg")
     'Dormant
     Home_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Home_Bttn_Dormant.jpg")
     Create_Summary_Report_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Create_Summary_Report_Bttn_Dormant.jpg")
     Review_Summary_Report_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Review_Summary_Report_Bttn_Dormant.jpg")
     Add_Report_Template_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Add_Report_Template_Bttn_Dormant.jpg")
     Add_Calbration_Certificates_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Add_Calbration_Certificates_Bttn_Dormant.jpg")
     Add_to_Database_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Add_to_Database_Bttn_Dormant.jpg")
     User_Agreement_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\User_Agreement_Bttn_Dormant.jpg")
     Email_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Email_Bttn_Dormant.jpg")
     Mobile_Bttn.Picture = LoadPicture(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Mobile_Bttn_Dormant.jpg")
     'Title
     Menu_Title.Caption = "Create Protocol"    
 End If    
End Sub

Editied Code:

Option Explicit

Private buttArrN As Variant, pictArr As Variant, dormArr As Variant

Private Sub Userform_Initialize()
'User form start up focus on multipage 1 and then focus on username field
Me.MultiPage1.Value = 0
Me.Login_Error_Message.Visible = False
Me.Username_fld.SetFocus

buttArrN = Array(Me.Home_Bttn.Name, Me.Mobile_Bttn.Name, Me.Email_Bttn.Name)
'Me.Create_Protocol_Bttn.Name, Me.Create_Summary_Report_Bttn.Name, Me.Review_Summary_Report_Bttn.Name, Me.Add_Report_Template_Bttn.Name, Me.Add_Calbration_Certificates_Bttn.Name, Me.Add_to_Database_Bttn.Name, Me.User_Agreement_Bttn.Name)

pictArr = Array(ThisWorkbook.Path & "\UI\General Buttons\Dormant\Home_Bttn_Dormant.jpg", _
        ThisWorkbook.Path & "\UI\General Buttons\Dormant\Mobile_Bttn_Dormant.jpg", _
        ThisWorkbook.Path & "\UI\General Buttons\Dormant\Email_Bttn_Dormant.jpg")

'        ThisWorkbook.Path & "\UI\General Buttons\Dormant\Create_Protocol_Bttn_Dormant.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Dormant\Create_Summary_Report_Bttn_Dormant.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Dormant\Review_Summary_Report_Bttn_Dormant.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Dormant\Add_Report_Template_Bttn_Dormant.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Dormant\Add_Calbration_Certificates_Bttn_Dormant.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Dormant\Add_to_Database_Bttn_Dormant.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Dormant\User_Agreement_Bttn_Dormant.jpg")


dormArr = Array("F:\Automation\Report Creation Wizard\UI\General Buttons\Activated\Home_Bttn_Activated.jpg", _
        ThisWorkbook.Path & "\UI\General Buttons\Activated\Mobile_Bttn_Activated.jpg", _
        ThisWorkbook.Path & "\UI\General Buttons\Activated\Email_Bttn_Activated.jpg")
'        ThisWorkbook.Path & "\UI\General Buttons\Activated\Create_Protocol_Bttn_Activated.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Activated\Create_Summary_Report_Bttn_Activated.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Activated\Review_Summary_Report_Bttn_Activated.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Activated\Add_Report_Template_Bttn_Activated.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Activated\Add_Calbration_Certificates_Bttn_Activated.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Activated\Add_to_Database_Bttn_Activated.jpg", _
'        ThisWorkbook.Path & "\UI\General Buttons\Activated\User_Agreement_Bttn_Activated.jpg")

End Sub

Private Sub Login_Bttn_Click()
'Execute login in module code
CheckUser

End Sub

Private Sub Home_Bttn_Click()
   testChangePicture Me.Home_Bttn
   Menu_Title.Caption = "User Login"
End Sub

Private Sub Mobile_Bttn_Click()
    testChangePicture Me.Mobile_Bttn
    Menu_Title.Caption = "Mobile Contact Menu"
End Sub

Private Sub Email_Bttn_Click()
    testChangePicture Me.Email_Bttn
    Menu_Title.Caption = "Email Contact Menu"
End Sub

'Private Sub Create_Protocol_Bttn_Click()
'    testChangePicture Me.Create_Protocol_Bttn
'    Menu_Title.Caption = "Create a Protocol"
'End Sub
'
'Private Sub Create_Summary_Report_Bttn_Click()
'    testChangePicture Me.Create_Summary_Report_Bttn
'    Menu_Title.Caption = "Create a Summary Report"
'End Sub
'
'Private Sub Review_Summary_Report_Bttn_Click()
'    testChangePicture Me.Review_Summary_Report_Bttn
'    Menu_Title.Caption = "Review Summary Report"
'End Sub
'
'Private Sub Add_Report_Template_Bttn_Click()
'    testChangePicture Me.Add_Report_Template_Bttn
'    Menu_Title.Caption = "Add a Report Template"
'End Sub
'
'Private Sub Add_Calbration_Certificates_Bttn_Click()
'    testChangePicture Me.Add_Calbration_Certificates_Bttn
'    Menu_Title.Caption = "Add Calibration Certificates"
'End Sub
'
'Private Sub Add_to_Database_Bttn_Click()
'    testChangePicture Me.Add_to_Database_Bttn
'    Menu_Title.Caption = "Add to Wizard Database"
'End Sub
'
'Private Sub User_Agreement_Bttn_Click()
'    testChangePicture Me.User_Agreement_Bttn
'    Menu_Title.Caption = "User Agreement"
'End Sub

Private Sub testChangePicture(but As Control)
 Dim c As Variant, pos As Long, i As Long

 pos = Application.Match(but.Name, buttArrN, False)
 Me.Controls(buttArrN(pos - 1)).Picture = LoadPicture(pictArr(pos))
 For Each c In buttArrN
    If c <> buttArrN(pos - 1) Then
       Me.Controls(c).Picture = LoadPicture(dormArr(i))
    End If
    i = i + 1
 Next
End Sub

Answer 1

Try the next code, please:

I prepared it for only three buttons, but I think the code can easily be extended of all controls existing in your project.

Firstly, create the next variables of the module level (on top of it, in the declarations part):

Option Explicit

Private buttArrN As Variant, pictArr As Variant, dormArr As Variant

Then, put this code in the Form_Initialize event. You must extend the arrays according to your buttons number:

  buttArrN = Array(Me.Home_Bttn.Name, Me.Create_Protocol_Bttn.Name, Me.Add_Report_Template_Bttn.Name)

  pictArr = Array(ThisWorkbook.path & "\UI\General Buttons\Activated\Home_Bttn_Activated.jpg", _
        ThisWorkbook.path & "\UI\General Buttons\Activated\Create_Protocol_Bttn_Activated.jpg", _
        ThisWorkbook.path & "\UI\General Buttons\Activated\Add_Report_Template_Bttn_Activated.jpg")

  dormArr = Array(ThisWorkbook.path & "\UI\General Buttons\Dormant\Home_Bttn_Dormant.jpg", _
        ThisWorkbook.path & "\UI\General Buttons\Dormant\Create_Summary_Report_Bttn_Dormant.jpg", _
            ThisWorkbook.path & "\UI\General Buttons\Dormant\Add_Report_Template_Bttn_Dormant.jpg")

Each of your buttons to change their picture Click event will call a single sub, as following:

Private Sub Home_Bttn_Click()
   testChangePicture Me.Home_Bttn
   Me.Repaint
End Sub

Private Sub Create_Protocol_Bttn_Click()
    testChangePicture Me.Create_Protocol_Bttn
    Me.Repaint
End Sub

Private Sub Add_Report_Template_Bttn_Click()
    testChangePicture Me.Add_Report_Template_Bttn
    Me.Repaint
End Sub

And the called sub will look like this:

Private Sub testChangePicture(but As Control)
 Dim c As Variant, pos As Long, i As Long

 pos = Application.Match(but.Name, buttArrN, False)
 If pos = 0 Then MsgBox but.Name & " button is missing from ""buttArrN"" array!": Exit Sub

 If Not FileExists(pictArr(pos - 1)) Then _
        MsgBox "The path to the active picture """ & pictArr(pos - 1) & """ is wrong!": Exit Sub

 Me.Controls(buttArrN(pos - 1)).Picture = LoadPicture(pictArr(pos - 1))

 For Each c In buttArrN
    If c <> buttArrN(pos - 1) Then
       If Not FileExists(dormArr(i)) Then _
            MsgBox "The path to the dormant picture """ & dormArr(i) & """ is wrong!": Exit Sub
            Me.Controls(c).Picture = LoadPicture(dormArr(i))
    End If
    i = i + 1
 Next
End Sub

Private Function FileExists(ByVal fName As String) As Boolean
    On Error Resume Next
      FileExists = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
    On Error GoTo 0: Err.Clear
End Function

I was too lazy to build paths for real pictures, so the code is not tested on the real environment. I just tested the fact that testChangePicture sub is able do identify the caller button.

Edited: I added a new function (FileExists) which checks if the pictures path is correct. If not, it stops the code and sends an elocvent message. I also added an new line Me.Repaint in all buttons click event. In my case, the code works without it, but in yours doesn't. It was simpler to force the form repainting, then finding the reason...

Important is to understand how the code works and take care to properly fill the three arrays. They must be filled in the same order for each involved control!

Answer 2

I would recommed a slightly different approach

Pros:

1. You do not have to depend on a hardcoded path for the images
2. You can distribute your workbook without having to worry about images
3. Your code drasssssssssticaly reduces!

In Action

Logic

Place relevant number of image controls in your userform and set their visible property to False. Upload all images from ...\UI\General Buttons\... path and store it in these image controls.

Now all you have to do is use a one liner to load the relevant image. No need of LoadPicture anymore. For example

Image1.Picture = Image3.Picture

In the above example, I created a userform and placed 3 image controls and a togglebutton as shown below

And the code that I used is

Option Explicit

Private Sub UserForm_Initialize()
    Image1.Picture = Image2.Picture
End Sub

Private Sub ToggleButton1_Click()
    If ToggleButton1.Value = True Then
        Image1.Picture = Image3.Picture
    Else
        Image1.Picture = Image2.Picture
    End If
End Sub

Answer 3

Since I didn't have your images, I just made an example with a bunch of different ones.

My example has 3 buttons on a form (Btn1, Btn2, Btn3) and uses 6 Images (red_on.bmp, red_off.bmp, blue_on.bmp, blue_off.bmp, green_on.bmp, green_off.bmp)

The code in UserForm_Initialize Pre-loads the images and activates Btn1

Buttons are Activated by passing the name of the button to ActivateButton

Private MenuControl As Object

Private Sub Btn1_Click()
ActivateButton "Btn1"
End Sub

Private Sub Btn2_Click()
ActivateButton Me.ActiveControl.Name
End Sub

Private Sub Btn3_Click()
ActivateButton "Btn3"
End Sub

Private Sub UserForm_Initialize()

If MenuControl Is Nothing Then Set MenuControl = CreateObject("Scripting.Dictionary")

' MenuControl.Add <Button>.Name, Array(<Button>, <Button State 1>, <Button State 2>, <Button Group>)
MenuControl.Add Btn1.Name, Array(UserForm1.Btn1, LoadPicture(ThisWorkbook.Path & "\red_on.bmp"), LoadPicture(ThisWorkbook.Path & "\red_off.bmp"), "Main")
MenuControl.Add Btn2.Name, Array(UserForm1.Btn2, LoadPicture(ThisWorkbook.Path & "\blue_on.bmp"), LoadPicture(ThisWorkbook.Path & "\blue_off.bmp"), "Main")
MenuControl.Add Btn3.Name, Array(UserForm1.Btn3, LoadPicture(ThisWorkbook.Path & "\green_on.bmp"), LoadPicture(ThisWorkbook.Path & "\green_off.bmp"), "Main")

ActivateButton TargetName:="Btn1"

End Sub


Private Sub ActivateButton(TargetName As String)
Dim Key As Variant
Dim Group As String: Group = MenuControl.Item(TargetName)(3)

For Each Key In MenuControl.Keys
    If MenuControl.Item(Key)(3) = Group Then
        If Key = TargetName Then
            MenuControl.Item(Key)(0).Picture = MenuControl.Item(Key)(1)
        Else
            MenuControl.Item(Key)(0).Picture = MenuControl.Item(Key)(2)
        End If
    End If
Next Key

End Sub

The above code is similar to that of the example below but has the ability to make groups of buttons.

Example Workbook