La adición de hipervínculo a la etiqueta creada dinámicamente en VBA Excel

Atul Patil:

Tengo varias etiquetas creadas dinámicamente en formulario de usuario. Quiero añadir un hipervínculo a las etiquetas creadas, ¿hay una manera de que pudiera añadir hipervínculo a estas etiquetas. Aquí está el código de cómo creé las etiquetas de forma dinámica.

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

así es como la parte de la forma se parece

Para dar una breve de mi caso de uso: Tengo algunos archivos / informes (pdf, word, etc ..) que necesito para adjuntar a un registro. El usuario puede adjuntar sus informes a los registros y también ver si los informes que se adjuntan. Así que con el código anterior Soy capaz de generar las etiquetas con los archivos dentro de la carpeta; Ahora, cuando los nombres de archivo se muestran en el formulario, quiero una funcionalidad donde es hacer clic en el informe (etiqueta) Quiero que el informe se abra.

Gracias por adelantado !!!

Brian M Stafford:

Se puede utilizar la mayor parte del código en esta respuesta con sólo una ligera modificación. Usted tendrá que modificar la clase MyControl a usar en lugar de etiquetas de comando. También tendrá que modificar el evento para pasar el nombre de archivo.

Una vez que estas modificaciones se han completado, su código es más o menos la misma, también. Aquí está el código original simplificado y modificado para ilustrar el concepto:

Formulario de usuario

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

Y aquí es los archivos de soporte modificados para una referencia rápida:

Módulo

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

Clase notificador

Option Explicit

Public Event Click(ByVal Filename As String)

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

Clase MyControl

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