Поскольку каждое условие использует один и тот же левый операнд в сравнении, блок If...Else If...End If может быть выражен с помощью блока Select...Case...End Select, и это уже уменьшит некоторые повторения.
Private Function GetMacroName(ByVal source As Range) As String
Select Case Range("D5")
Case "YELLOW":
GetMacroName = "yellow"
Case "BLACK":
GetMacroName = "black"
Case "BLACK/WHITE"
GetMacroName = "black_white"
'...
Case Else
GetMacroName = "blank"
End Select
End Function
И затем вы можете использовать Application.Run для вызова безпараметрической процедуры:
Application.Run GetMacroName(Range("D5"))
Вы можете использовать al oop для запуска этой инструкции для разных диапазонов:
Dim sheet As Worksheet
Set sheet = ActiveSheet '<~ sure of that?
Dim i As Long
For i = 1 To N '<~ N=number of iterations; presumably the number of oval shapes
Dim oval As Shape
On Error Resume Next '<~ manually handle non-existing shape #i
Set oval = sheet.Shapes("Oval " & i)
On Error GoTo 0
If Not oval Is Nothing Then
Application.Run GetMacroName(sheet.Range("D" & 5 + i - 1)), oval
End If
Set oval = Nothing
Next
В качестве альтернативы мы могли бы выполнить итерацию Shapes коллекция листа:
Dim sheet As Worksheet
Set sheet = ActiveSheet '<~ sure of that?
Dim oval As Shape, i As Long
For Each oval In sheet.Shapes
i = i + 1
If Left(oval.Name, 4) = "Oval" Then
Application.Run GetMacroName(sheet.Range("D" & 5 + i)), oval
End If
Next
Обратите внимание, что в обоих случаях макрос получает объект Shape, с которым он работает. Передавая параметры, вы делаете свой код менее зависимым от глобального состояния и более простым для отслеживания: вам не нужно выяснять, кто из вызывающих 3 создает кадр вызова, который в некоторой форме вызывает .Select, чтобы знать, что вы ' работает с! Передача параметров значительно упрощает отладку позже.
Public Sub Yellow(ByVal sh As Shape)
sh.ForeColor = vbYellow
End Sub
Обратите внимание, что если это все, что здесь происходит, у вас должен быть только один макрос вместо:
Public Sub FormatOvalShape(ByVal oval As Shape, ByVal color As Long)
oval.ForeColor = color
'...
End Sub
.. и пусть звонящий параметризирует вызов - вы еще больше уменьшите дублирование кода. На самом деле, это избавило бы от необходимости отображать имена макросов; вместо этого мы отображаем цветовые коды:
Dim sheet As Worksheet
Set sheet = ActiveSheet '<~ sure of that?
Dim oval As Shape, i As Long
For Each oval In sheet.Shapes
If Left(oval.Name, 4) = "Oval" Then
FormatOvalShape oval, GetColorCode(sheet.Range("D" & 5 + i))
End If
i = i + 1
Next