2014-01-16 3 views
4

В настоящее время у меня есть поле со списком в Excel, которое назначено «Макросписок» на отдельном листе, в котором указано примерно 200 различных макросов. Иногда бывает полезно искать в раскрывающемся списке, чтобы получить макрос, который вы хотите выбрать (они в порядке чисел, поэтому это не так уж плохо), но я думаю, что это может быть лучше.Вызов макроса по шаблону в ячейке в Excel VBA

Большинство макросов структурированы таким образом «PA1111_Name» - я бы хотел, чтобы пользователь мог ввести всего 1111 в ячейку и нажать кнопку «запустить», которая направляется к указанному макросу. В SQL это было бы что-то вроде этого:

SELECT Macro FROM Module WHERE Macro Like '*' & Cell.A2 & '*' 

Эти номера являются уникальными, так что я не обеспокоенный с потенциалом для захвата нескольких макросов.

Спасибо!

+0

Вы ВСЕГДА хотите звонить ТОЛЬКО один макрос за раз или могут быть выведены еще несколько макросов, если их имена соответствуют критериям? –

+0

, быстрый способ может заключаться в том, чтобы включить их в одну часть и использовать оператор case для запуска только того раздела кода, который вам нужен. Кроме того, вы можете использовать вызов по имени, если он в форме или Application.Run, если его внутренний amodule – user2140261

+0

@KazJaw да, всегда будет только один макрос, вызываемый одновременно в этом экземпляре. – Dm3k1

ответ

2

Ниже перечислены все макросы внутри модуля сопоставления Active VBProject и проверьте, содержит ли Имя значение, указанное в A1, если оно будет запускаться с этим макросом, если ни один не найден, он отображает «Нет найденных макросов» Соответствие введенного значения.

Помните, что это запустит только первый макрос, который он найдет, со значением, содержащимся в нем, так как я предположил, что у вас не было повторяющихся значений в именах макросов.

Sub RunMacroContainingValue() 
Dim cpCurrent As VBComponent 
Dim lngCurrentLine As Long 
Dim SubName As String 
For Each cpCurrent In Application.VBE.ActiveVBProject.VBComponents 
    If cpCurrent.Name = "Mapping" Then 
     With cpCurrent.CodeModule 
      lngCurrentLine = .CountOfDeclarationLines + 1 
      Do Until lngCurrentLine >= .CountOfLines 
       SubName = .ProcOfLine(lngCurrentLine, 0) 
       If InStr(SubName, [A1]) > 0 Then 
        Application.Run SubName 
        Exit Sub 
       End If 
       lngCurrentLine = .ProcStartLine(SubName, 0) + _ 
       .ProcCountLines(SubName, 0) + 1 
      Loop 
     End With 
    End If 
Next cpCurrent 
MsgBox "No Values Found Matching Value" 
End Sub 
+0

Спасибо , отлично работает. – Dm3k1

Смежные вопросы