Попробуйте следующий код, пожалуйста:
Я подготовил его только для трех кнопок, но я думаю, что код можно легко расширить на все элементы управления, существующие в вашем проекте.
Во-первых, создайте следующие переменные уровня модуля (поверх него, в части объявлений):
Option Explicit
Private buttArrN As Variant, pictArr As Variant, dormArr As Variant
Затем поместите этот код в событие Form_Initialize. Вы должны расширить массивы в соответствии с вашим номером кнопки:
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")
Каждая из ваших кнопок, чтобы изменить свое изображение * Событие 1012 * будет вызывать одну подпрограмму, как показано ниже:
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
И вызываемая подпрограмма будет выглядеть так:
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
Мне было лень строить пути для реальных изображений, поэтому код не тестировался в реальной среде. Я только что проверил тот факт, что testChangePicture sub может идентифицировать кнопку вызова.
Отредактировано: я добавил новую функцию (FileExists), которая проверяет правильность пути к изображениям. Если нет, он останавливает код и отправляет сообщение elocvent. Я также добавил новую строку Me.Repaint во всех событиях нажатия кнопок. В моем случае код работает без него, а в вашем - нет. Проще было перерисовать форму, затем найти причину ...
Важно понять, как работает код, и позаботиться о том, чтобы правильно заполнить три массива. Они должны быть заполнены в том же порядке для каждого задействованного элемента управления !