Программно сгенерировать гиперссылки для запуска макросов - PullRequest
1 голос
/ 25 октября 2019

Я пытаюсь запустить макрос через гиперссылку на сгенерированном листе.

Как правило, это делается так, как показано здесь . Этот метод требует, чтобы пользователь вручную ссылался на ячейку, через которую он хочет запустить гиперссылку. Я могу заставить этот метод работать при тестировании, но я не могу сделать это на сгенерированном рабочем листе. У меня есть внедрение кода в сгенерированный лист, уже написанный и протестированный ( credit ) ( credit ):

Sub CreateEventProcedure()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(Worksheets("##WORKSHEET NAME##").CodeName)
Set CodeMod = VBComp.CodeModule
With CodeMod
    LineNum = .CreateEventProc("FollowHyperlink", "Worksheet")
    LineNum = LineNum + 1
    .InsertLines LineNum, "    ###INJECTED CODE GOES HERE##"
End With
End Sub

Я попытался создать гиперссылку безудача:

with ws
    .Hyperlinks.Add _
        Anchor:=.Range(.Cells(1, loc), .Cells(1, loc)), _
        Address:="'", _
        SubAddress:="'" & ws.Name & "'!" & .Range(.Cells(1, loc), .Cells(1, loc)).Address
end with

Следует отметить, что конечные местоположения, отображаемые при наведении на текст, являются точно такими же .

Любая идея, как скопировать ручной метод гиперссылкиот поколения к макросам?

1 Ответ

1 голос
/ 25 октября 2019

Если вы хотите вставить гиперссылки в набор ячеек, которые просто перепрыгивают на себя, то Select их и запустите:

Sub HyperAdder()
   For Each r In Selection
      ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:=r.Parent.Name & "!" & r.Address(0, 0), TextToDisplay:="myself"
   Next r
End Sub

РЕДАКТИРОВАТЬ # 1:

На основании комментария Тима Уильямса, вот обновление:

Sub HyperAdder2()
   For Each r In Selection
      ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:="'" & r.Parent.Name & "'" & "!" & r.Address(0, 0), TextToDisplay:="myself"
   Next r
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...