如何在单个单元格中插入多个超链接?

时间:2018-01-03 10:17:33

标签: excel vba image excel-vba hyperlink

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

enter image description here

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

1 个答案:

答案 0 :(得分:1)

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

用户可以点击并打开相应的文件。细胞最终如下所示:

The images in the cell

下载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