Question

我正在尝试自动创建图片文件的超链接列表。我的工作表有A列中列出的文件名，我希望这些文件的超链接（保存在工作表的父文件夹中）为columm B.我是VBA的初学者，但是这应该是相当简单的，但是我无法找到一种方法来做到这一点。

我尝试使用Macro Recorder并得到了这个：

    Sub Hyperlink()
'
' Hyperlink Macro
'
' Keyboard Shortcut: Ctrl+l
'
    ActiveCell.Offset(0, -1).Range("Table1[[#Headers],[ACTIVITY '#]]").Select
    ActiveCell.FormulaR1C1 = "file(a)"
    ActiveCell.Offset(0, 1).Range("Table1[[#Headers],[ACTIVITY '#]]").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "..\file(a).JPG", TextToDisplay:="..\file(a).JPG"
    ActiveCell.Offset(1, 0).Range("Table1[[#Headers],[ACTIVITY '#]]").Select
End Sub

非常感谢任何帮助。欢呼声。

Answer 1

您可以遍历单元格并创建超链接，只需引用包含数据的列。

Sub CreateJpgHyperLinks()
Dim iRow, iCol As Integer 'row and column counters

iRow = 1 'change to 2 if there are headers
iCol = 1 'Column A
    'this assumes there is data in all cells in column A
    Do While ActiveSheet.Cells(iRow, iCol).Value <> ""
        'set the link in column B and point it to the info in column A
        ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(iRow, iCol + 1), Address:=ActiveSheet.Cells(iRow, iCol).Value, _
        TextToDisplay:=ActiveSheet.Cells(iRow, iCol).Value
        'move to the next row
        iRow = iRow + 1
    Loop

End Sub

要查找文件夹，您可以使用以下方法

'get path to current workbook
workbookPath = ActiveWorkbook.Path
'find the last slash in the workbook path
iLastFolderSlash = InStrRev(workbookPath, "\")
'create the folder location by removing the last folder from the path
jpgFolderPath = Left(workbookPath, iLastFolderSlash)

如何创建本地存储文件的超链接列表？

1 个答案: