如何在单个单元格中插入多个超链接？答案

【问题标题】：How to insert multiple hyperlinks in a single cell?如何在单个单元格中插入多个超链接？
【发布时间】：2018-06-13 00:13:15
【问题描述】：

我需要一种使用 VBA 在 Excel 中的单个单元格中包含多个链接的方法。我有一个 excel 表，单元格是这样的：

我需要在一个单元格内有 3 个链接，每个链接指向一个不同的文件，那么我如何在一个单元格中有多个链接？

【问题讨论】：

标签： vba image excel hyperlink

【解决方案1】：

我们可以通过在单元格中插入小图像并适当调整它们来实现这一点。

用户将能够点击并打开相应的文件。单元格最终如下所示：

下载link.png

功能：

'Put this in your module

Sub PutLinksInACell()
    Dim rangeAddress As String
    Dim fileArray
    fileArray = Array("144234\SDFsdf0fghf10_144234.pdf", "144234\ghfrg35bzb-20-1_R04.docx", "144234\xcvbebeEN 113.pdf")
    'rangeAddress = Selection.Cells(1, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
    insertPicture Application.ActiveWorkbook.Path & "\link.png", "A1", fileArray
End Sub

Sub insertPicture(picpath As String, cellAddress As String, fileArray As Variant)
    '----------------------------------------------------------------------------
    ' "THE BURGER-WARE LICENSE" (Revision 42):
    ' <abybaddi009 gmail.com> wrote this code. As long as you retain this notice you
    ' can do whatever you want with this stuff. If we meet some day, and you think
    ' this stuff is worth it, you can buy me a burger in return. ;-) -Abhishek Baddi
    '----------------------------------------------------------------------------

    Dim spacing As Long, size As Long

    size = Range(cellAddress).Font.size
    spacing = size * 0.2

    x_coor = Range(cellAddress).Cells(1, 1).Left
    y_coor = Range(cellAddress).Cells(1, 1).Top

    For i = 1 To 3
        ActiveSheet.Pictures.Insert(picpath).Select
        With Selection
            With .ShapeRange
                .LockAspectRatio = msoTrue
                .Height = size
            End With
            .Left = x_coor + 5
            .Top = y_coor + size * (i - 1) + spacing * i
            .Placement = 1
            .PrintObject = True
        End With

        ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:= _
            fileArray(i - 1)

        Range(cellAddress).Select
    Next
    Range(cellAddress).HorizontalAlignment = xlLeft
    Range(cellAddress).VerticalAlignment = xlTop
End Sub

【讨论】：