vba 如何创建本地存储文件的超链接列表？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16157500/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to create a list of hyperlinks to files stored locally?
提问by TrevorS
I'm trying to automate the creation of a list of hyperlinks to picture files. My worksheet has the filenames listed in column A and I want the hyperlinks to those files (saved in the parent folder of the worksheet) to columm B. I am a beginner to VBA, but thougth this should be fairly simple, however I was unable to find a way to do this.
我正在尝试自动创建指向图片文件的超链接列表。我的工作表的文件名列在 A 列中，我希望这些文件的超链接（保存在工作表的父文件夹中）到 B 列。我是 VBA 的初学者，但这应该相当简单，但是我无法找到一种方法来做到这一点。
I tried using the Macro Recorder and got this:
我尝试使用宏记录器并得到这个：
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
Any help would be very appreciated. Cheers.
任何帮助将不胜感激。干杯。
采纳答案by Sorceri
You can loop through the cells and create the hyperlinks and just reference the column that holds the data.
您可以遍历单元格并创建超链接，然后只引用包含数据的列。
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
To find the folder you can use the method below
要找到文件夹，您可以使用以下方法
'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)
