Запустите Excel-Macro с = HYPERLINK-Formula (через событие Selection_Change)

Question

Я хочу найти способ динамически добавлять гиперссылки в мой Excel-Sheet и запускать макросы в зависимости от содержимого некоторых ячеек. Но ни формула ГИПЕРССЫЛКА, ни функция обычных гиперссылок в Excel не позволяют вызывать макросы прямо из рабочего листа. При поиске этой проблемы в Интернете всегда будет найдена возможность использовать событие Worksheet_FollowHyperlink. Но для моей цели этот вариант не подходит, так как вам либо нужно написать свой макрос так, чтобы «if target.range.address = A1 call macroA elseif target.cell = A2 call macro ....» et c ... Это решение, на мой взгляд, слишком c, так как вам нужно слишком много "зашивать" в коде Worksheet_FollowHyperlink. Кроме того, вы должны подготовить гиперссылки через VBA, чтобы изменить адрес и подадрес на «», чтобы избежать нежелательных изменений выбора или всплывающих окон ошибок из excel (потому что не удалось найти какой-то адрес).

The = HYPERLINK () - формула выглядит намного интереснее, так как вы можете динамически создавать ее где угодно и когда угодно. Он также отлично работает как функция-столбец внутри таблицы, что я действительно хочу сделать: иметь столбец, заполненный гиперссылками внутри таблицы, который будет запускать макросы с некоторыми заданными параметрами в зависимости от другого содержимого в каждой строке данных таблицы. Это вообще не будет работать с обычными гиперссылками, поскольку пользователь должен копировать и вставлять их вручную в каждую строку.

К сожалению, формула = HYPERLINK () - также не предлагает возможности напрямую запускать макрос с заданным параметры (по крайней мере, я не смог найти). Он даже не вызовет событие Worksheet_FollowHyperlink, так что на данный момент он кажется тупиком. Интересная особенность, которую я обнаружил во время исследования методом проб и ошибок + inte rnet: = HYPERLINK ("# TestMe", "Some text here ...") откроет VBA-редактор и сразу перейдет к моей подпрограмме TestMe (). Но он не будет вызываться!

Что может быть решением этой проблемы?

• Динамическое создание гиперссылок в столбце данных таблицы
• Вызов макроса в зависимости от содержимое строки данных

Answer 1

У меня возникла идея использовать событие Workbook_SheetSelectionChange, чтобы отслеживать, была ли выбрана ячейка с формулой HYPERLINK, и это оказалось очень хорошо.

Первая редакция моего кода:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim MacroName As String
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Formula Like "=HYPERLINK(LEFT(""|""*""|"",*),*)" Then
        MacroName = Split(Target.Formula, """|""")(1)
        MacroName = VBA.Trim(Replace(MacroName, "&", ""))
        MacroName = Sh.Evaluate(MacroName)
        
        Application.Run Macro
    End If

End Sub

Требуется ячейка со следующей формулой: = ГИПЕРССЫЛКА (LEFT ("|" & A1 & "|", 0), "Запустить макрос в A18"), где ячейка A1 содержит имя некоторого макроса, который я хочу запустить. Имя макроса также может быть зашито в формуле.

Примечание: необходима ЛЕВАЯ (..., 0) часть, поэтому адрес гиперссылки будет казаться пустым, чтобы выделяться при нажатии на нее. В противном случае это будет беспокоить вас всплывающим окном с ошибкой из-за того, что цель не найдена.

К сожалению, событие SelectionChange также запускается при выборе ячейки с помощью клавиши возврата, клавиши табуляции или клавиш со стрелками. Чтобы отфильтровать их, вам понадобится следующий вызов API:

Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vkey As Integer) As Boolean

Эта функция проверяет, нажата ли клавиша в момент ее вызова. Источник - это нерешенный вопрос: Как запустить код при щелчке по ячейке?

Следующая эволюция приведенного выше кода теперь выглядит так:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If GetAsyncKeyState(vbKeyTab) _
         Or GetAsyncKeyState(vbKeyReturn) _
         Or GetAsyncKeyState(vbKeyDown) _
         Or GetAsyncKeyState(vbKeyUp) _
         Or GetAsyncKeyState(vbKeyLeft) _
         Or GetAsyncKeyState(vbKeyRight) _
         Or Target.Cells.Count > 1 _
         Or VBA.TypeName(Sh) <> "Worksheet" _
    Then Exit Sub
    
    Dim Macro As String
    
    If Target.Formula Like "=HYPERLINK(LEFT(""|""*""|"",*),*)" Then
        Macro = Split(Target.Formula, """|""")(1)
        Macro = VBA.Trim(Replace(Macro, "&", ""))
        Macro = Sh.Evaluate(Macro)
        
        Application.Run Macro
    End If

End Sub

Это сейчас отфильтрует все изменения выбора, сделанные ключевыми командами. Тем не менее, есть еще один шаг, который нужно сделать, поскольку я должен был заметить, что, похоже, есть ошибка при изменении ячейки выше или слева от моей гиперссылки и нажатии клавиши возврата или клавиши табуляции. По какой-то причине GetAsyncKeyState вернет false для обоих ключей, так что мой код продолжит работу.

Поэтому для этих ситуаций мне пришлось создать небольшую грязную работу. Вам понадобится событие Workbook_SheetChange, чтобы установить переключатель, который временно отключает событие Workbook_SheetSelectionChange.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    RecentSheetChange = True
    Application.OnTime VBA.DateAdd("s", 0.1, Now), "ResetRecentSheetChange"
End Sub

'Code inside a new module:

Option Explicit
Option Private Module

Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vkey As Integer) As Boolean
Public RecentSheetChange As Boolean

Private Sub ResetRecentSheetChange()
    RecentSheetChange = False
End Sub

Окончательный код в ThisWorkbook теперь выглядит следующим образом:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If GetAsyncKeyState(vbKeyTab) _
         Or GetAsyncKeyState(vbKeyReturn) _
         Or GetAsyncKeyState(vbKeyDown) _
         Or GetAsyncKeyState(vbKeyUp) _
         Or GetAsyncKeyState(vbKeyLeft) _
         Or GetAsyncKeyState(vbKeyRight) _
         Or Target.Cells.Count > 1 _
         Or VBA.TypeName(Sh) <> "Worksheet" _
         Or RecentSheetChange _
    Then Exit Sub
    
    Dim Macro As String
    
    If Target.Formula Like "=HYPERLINK(LEFT(""|""*""|"",*),*)" Then
        Macro = Split(Target.Formula, """|""")(1)
        Macro = VBA.Trim(Replace(Macro, "&", ""))
        Macro = Sh.Evaluate(Macro)
        
        Application.Run Macro
    End If

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    RecentSheetChange = True
    Application.OnTime VBA.DateAdd("s", 0.1, Now), "ResetRecentSheetChange"
End Sub

Добавление функций параметров в гиперссылка находится всего в нескольких шагах отсюда.

Ваши мысли?