VBA代码列下的超链接特定单元格

Question

我有一个宏来搜索不同工作表上的值。代码工作正常，但问题是我希望 C 列下的单元格的值被超链接，我无法这样做。

所以一旦我点击超链接单元格，它应该会打开源文件。

代码如下：

Sub SearchFolders()

Dim xFso As Object
Dim xFld As Object
Dim xStrSearch As String
Dim xStrPath As String
Dim xStrFile As String
Dim xOut As Worksheet
Dim xWb As Workbook
Dim xWk As Worksheet
Dim xRow As Long
Dim xFound As Range
Dim xStrAddress As String
Dim xFileDialog As FileDialog
Dim xUpdate As Boolean
Dim xCount As Long
On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "select folder"
If xFileDialog.Show = -1 Then
    xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
xStrSearch = "searched value"
xUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
Set xOut = Worksheets.Add
xRow = 1
With xOut
    .Cells(xRow, 1) = "book"
    .Cells(xRow, 2) = "sheet"
    .Cells(xRow, 3) = "cell"
    .Cells(xRow, 4) = "search value"
    Set xFso = CreateObject("Scripting.FileSystemObject")
    Set xFld = xFso.GetFolder(xStrPath)
    xStrFile = Dir(xStrPath & "\*.xls*")
    Do While xStrFile <> ""
        Set xWb = Workbooks.Open(Filename:=xStrPath & "\" & xStrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
        For Each xWk In xWb.Worksheets
            Set xFound = xWk.UsedRange.Find(xStrSearch)
            If Not xFound Is Nothing Then
                xStrAddress = xFound.Address
            End If
            Do
                If xFound Is Nothing Then
                    Exit Do
                Else
                    xCount = xCount + 1
                    xRow = xRow + 1
                    .Cells(xRow, 1) = xWb.Name
                    .Cells(xRow, 2) = xWk.Name
                    .Cells(xRow, 3) = xFound.Address
                    .Cells(xRow, 4).Range("A1:T1").Value = xFound.EntireRow.Range("A1:T1").Value                       
                End If
                Set xFound = xWk.Cells.FindNext(After:=xFound)
            Loop While xStrAddress <> xFound.Address
        Next
        xWb.Close (False)
        xStrFile = Dir
    Loop
    .Columns("A:D").EntireColumn.AutoFit
End With
MsgBox xCount & "Cells found", , "EA"

ExitHandler:
Set xOut = Nothing
Set xWk = Nothing
Set xWb = Nothing
Set xFld = Nothing
Set xFso = Nothing
Application.ScreenUpdating = xUpdate
Exit Sub    
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub

Answer 1

一种方法是使用 HYPERLINK() 函数。而不是

.Cells(xRow, 3) = xFound.Address

使用

.Cells(xRow, 3).Formula = "=HYPERLINK(""" & xWb.FullName & """)"