向VBA Excel中动态创建的标签添加超链接

我在Userform上动态创建了多个标签。我想向已创建的标签添加超链接，是否有办法向这些标签添加超链接。下面是我如何动态创建标签的代码

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等）需要附加到记录中。用户可以将其报告附加到记录中，也可以查看已附加的报告。因此，通过上面的代码，我能够生成文件夹中文件的标签；现在，当文件名显示在表单上时，我需要一个功能，即单击要打开该报告的报告（标签）

---

提前感谢

我建议您对每个标签使用以下代码：

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

• --->您需要的功能是

  活动工作簿中的
  FollowHyperlink

您需要确保：

标签1是标签

每个标签的标题都是有效的URL超链接

为了获得更好的格式，您需要确保标签的格式为超链接

一旦用户单击标签，它将直接指向具有给定链接的默认浏览器

希望它能帮助你

---

[版本：只是将答案格式化得更好]

您只需稍加修改即可使用其中的大部分代码。您需要修改MyControl类以使用标签而不是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

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

MyControl类

Option Explicit

Public Event Click(ByVal Filename As String)

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

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

---

我知道这个功能，但这不是我需要创建超链接的方式。由于我已经动态创建了标签，我不确定单击事件会发生在哪里。您仍然可以这样设置

标签\u click

，但请确保用户分配给标题的超链接是有效的超链接。@Tsirinianarakotoninina因为在运行时之前控件的数量是未知的，如何实现这一点？看看你的主要问题，你可以在函数中使用

Dir（Labelxxx.Caption）

，只要结果不同于

vbNullString

，那么文件就存在了。因此

Dir

函数应该在赋值时测试每个

Labelxxx.Caption

。然后，您可以在单击每个标签时使用

FollowHyperlink

函数。请参见：它使用类，但我认为如果您想坚持使用动态创建的控件，这是唯一的方法。你有没有想过使用“静态”控件并隐藏/不隐藏它们？我最近回答了一个类似的问题，涵盖了这种情况。这应该会有帮助。@BrianMStafford说实话，对我来说理解代码有点困难。如果您能帮助我构建代码，这将意味着很多：）好的，下面是我所做的创建类模块clsMyEvents。添加了以下行“Option Explicit Public With Events File_name As MSForms。标记私有子文件_name_Click（ByVal链接为字符串）ActiveWorkbook.FollowHyperlink Address:=链接，NewWindow:=True End Sub”，就在代码中的结尾处（主要问题）我把这个Dim lblEvent作为clsMyEvents Set lblEvent=New clsMyEvents Set lblEvent.File\u name=theLabel1 MyEvents.Add lblEvent Next End Sub`我想把链接传递到clsMyEvents，怎么做？好了，下面是我创建类模块clsMyEvents的步骤。添加了以下行

选项Explicit Public With events File_name As MSForms。标记私有子文件\u name_Click（ByVal链接为String）ActiveWorkbook.FollowHyperlink Address:=link，NewWindow:=True End Sub

就在代码中的结尾之后（主要问题）我有一个'Dim lblEvent As clsMyEvents Set lblEvent=New clsMyEvents Set lblEvent.File\u name=theLabel1 MyEvents.Add lblEvent Next End Sub'我想把链接传递到clsMyEvents，怎么做？这对搭档有什么事吗？你真是个天才。工作非常好，但这里唯一的事情是当我单击文件时，我在msgbox中看到文件名，我需要的是如果我单击文件，它应该在该位置打开文件

，例如“C:\abc\xyz\Desktop\FV\”&sub\u folder&“\”&filename

。为了做到这一点，我需要使用

ActiveWorkbook.FollowHyperlink地址：=**link**

。使用所需的逻辑替换MsgBox，在本例中，使用FollowHyperlink，将文件名添加到位置。