Добавление гиперссылки на динамически создаваемую метку в VBA Excel

Question

У меня несколько меток, созданных динамически в пользовательской форме. Я хочу добавить гиперссылку на созданные ярлыки, есть ли способ добавить гиперссылку на эти ярлыки? Вот код того, как я создал ярлыки динамически.

Private Sub cmdViewReports_Click()

    Dim row_num As Long
    Dim fso As Object
    Dim src_path As String
    Dim dest_path As String
    Dim sub_folder As String
    Dim theLabel1 As msforms.Label
    Dim inc As Integer
    Dim my_files As Object
    Dim my_folder As Object
    Dim i As Integer
    Dim ctrl As Control

    'Check if the record is selected in listbox
    If Selected_List = 0 Then   

        MsgBox "No record is selected.", vbOKOnly + vbInformation, "Upload Results"

        Exit Sub

    End If

    'Folder Name to be created as per the 3rd column value in the list 
    sub_folder = Me.lstDb.List(Me.lstDb.ListIndex, 3)

    sub_folder = Replace(sub_folder, "/", "_")

    dest_path = "C:\abc\xyz\Desktop\FV\" & sub_folder & "\"

    Set fso = CreateObject("scripting.filesystemobject")

    If Not fso.FolderExists(dest_path) Then

        MsgBox "No reports are loaded"

        Exit Sub

    End If

    Set my_folder = fso.GetFolder(dest_path)
    Set my_files = my_folder.Files

    i = 1

    For Each oFiles In my_files
        Set theLabel1 = Me.Frame1.Controls.Add("Forms.Label.1", "File_name" & i, True)
                    With theLabel1
                        .Caption = oFiles.Name
                        .Left = 1038
                        .Width = 60
                        .Height = 12
                        .Top = 324 + inc
                        .TextAlign = 1
                        .BackColor = &HC0FFFF
                        .BackStyle = 0
                        .BorderStyle = 1
                        .BorderStyle = 0
                        '.Locked = True
                        .ForeColor = &H8000000D
                        .Font.Size = 9
                        .Font.Underline = True
                        .Visible = True
                    End With

                inc = inc + 12
                i = i + 1

    Next   
End Sub

вот как выглядит часть формы

Чтобы дать краткое описание моего варианта использования: у меня есть некоторые файлы / отчеты (pdf, word et c ..), которые мне нужно прикрепить к записи. Пользователь может прикреплять свои отчеты к записям, а также просматривать отчеты, если они прикреплены. Таким образом, с помощью приведенного выше кода я могу генерировать метки с файлами внутри папки; теперь, когда имена файлов отображаются в форме, я хочу, чтобы функциональность заключалась в щелчке по отчету (метке), который я хочу открыть для этого отчета.

Заранее спасибо !!!

Answer 1

Вы можете использовать большую часть кода в этом ответе с небольшими изменениями. Вам нужно будет изменить класс MyControl для использования Labels вместо CommandButtons. Вам также нужно будет изменить событие, передав ему имя файла.

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

UserForm

Option Explicit

Private WithEvents MyNotifier As Notifier
Private MyControls As Collection

Private Sub UserForm_Initialize()
   Set MyNotifier = GetNotifier()
   Set MyControls = New Collection
End Sub

Private Sub CommandButton1_Click()
   Dim i As Integer
   Dim inc As Integer
   Dim theLabel1 As MSForms.Label
   Dim mc As MyControl

   inc = 0

   For i = 1 To 2
      Set theLabel1 = Me.Frame1.Controls.Add("Forms.Label.1", "File_name" & i, True)

      With theLabel1
          .Caption = "filename" & i
          .Left = 100
          .Width = 60
          .Height = 12
          .Top = 20 + inc
          .TextAlign = 1
          .BackColor = &HC0FFFF
          .BackStyle = 0
          .BorderStyle = 1
          .BorderStyle = 0
          '.Locked = True
          .ForeColor = &H8000000D
          .Font.Size = 9
          .Font.Underline = True
          .Visible = True
      End With

      Set mc = New MyControl
      mc.Add theLabel1
      MyControls.Add mc

      inc = inc + 12
   Next
End Sub

Private Sub MyNotifier_Click(ByVal Filename As String)
   MsgBox Filename
End Sub

А вот измененные файлы поддержки для краткого справочника:

Модуль

Option Explicit

Private m_Notifier As Notifier

Public Function GetNotifier() As Notifier
   If m_Notifier Is Nothing Then Set m_Notifier = New Notifier

   Set GetNotifier = m_Notifier
End Function

Класс уведомлений

Option Explicit

Public Event Click(ByVal Filename As String)

Public Function Click(ByVal Filename As String)
   RaiseEvent Click(Filename)
End Function

MyControl Class

Option Explicit

Private MyNotifier As Notifier
Private WithEvents MyLabel As MSForms.Label

Public Sub Add(ByVal c As MSForms.Label)
   Set MyNotifier = GetNotifier()
   Set MyLabel = c
End Sub

Private Sub MyLabel_Click()
   MyNotifier.Click MyLabel.Caption
End Sub

Answer 2

Я предлагаю вам использовать следующий код для каждой метки:

Private Sub Label1_Click()
ActiveWorkbook.FollowHyperlink Label1.Caption
End Sub

• ---> Необходимая функция FollowHyperlink из ActiveWorkbook.

Необходимо убедиться, что:

1. Label1 является меткой
2. Заголовок каждой метки является действительным URL-адресом Гиперссылка
3. Для лучшего формата, Вам необходимо убедиться, что Метка правильно отформатирована как Гиперссылка

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

Надеюсь, это поможет вам!

[Редакция: Только что лучше отформатировал ответ]