在Excel中修复已损坏的超链接的脚本
我有一个用于跟踪工作订单的电子表格。 表格的第一列有从14-0001开始的数字，然后继续下降。 这些号码被超链接到他们各自工单的.XLS（例如，包含14-0001个链接到Z：\ WorkOrders \ 14-0001-任务名称\ 14-0001-任务名称.xls的单元格）
问题是，我的电脑崩溃了，当Excel恢复文件时，所有的超链接都从：
**"Z:\blah blah\WorkOrders\14-****-Task Name\14-****-Task Name.xls"** 至
**"C:\Users\blahblah\WorkOrders\14-****-Task Name\14-****-Task Name.xls"**
有数百个条目，所以我希望我可以运行一个脚本来修复所有的超链接。
下面是我在网上find的一个脚本，据我所知，它应该做我想做的事情，但是当我在Excel的VB窗口中运行脚本时，我得到了“编译错误：参数不是可选的”，并突出显示了Sub CandCHyperlinx()
码：
Option Explicit Sub CandCHyperlinx() Dim cel As Range Dim rng As Range Dim adr As String Dim delstring As String 'string to delete: CHANGE ME! (KEEP quotes!) delstring = "C:\Users\***\AppData\Roaming\Microsoft\Excel\" 'get all cells as range Set rng = ActiveSheet.UsedRange 'ignore non hyperlinked cells On Error Resume Next 'check every cell For Each cel In rng 'skip blank cells If cel <> "" Then 'attempt to get hyperlink address adr = cel.Hyperlinks(1).Address 'not blank? then correct it, is blank get next If adr <> "" Then 'delete string from address adr = Application.WorksheetFunction.Substitute(adr, delstring) 'put new address cel.Hyperlinks(1).Address = adr 'reset for next pass adr = "" End If End If Next cel End Sub
这甚至是正确的脚本？ 我究竟做错了什么？
尝试这个：
Sub Macro1() Const FIND_TXT As String = "C:\" 'etc Const NEW_TXT As String = "Z:\" 'etc Dim rng As Range, hl As Hyperlink For Each rng In ActiveSheet.UsedRange.Cells If rng.Hyperlinks.Count > 0 Then Set hl = rng.Hyperlinks(1) Debug.Print rng.Address(), "Before", hl.TextToDisplay, hl.Address hl.TextToDisplay = Replace(hl.TextToDisplay, FIND_TXT, NEW_TXT) hl.Address = Replace(hl.Address, FIND_TXT, NEW_TXT) Debug.Print rng.Address(), "After", hl.TextToDisplay, hl.Address End If Next rng End Sub
我刚刚有同样的问题，我试过的所有macros都不适合我。 这一个是从蒂姆的上面，从这个线程Office Techcentre线程改编的。 在我的情况下，我所有的超链接都在B列，在第3行和第400行之间，隐藏在文件名后面，我想把链接放回到我所属的Dropbox文件夹中。
Sub FixLinks3() Dim intStart As Integer Dim intEnd As Integer Dim strCol As String Dim hLink As Hyperlink intStart = 2 intEnd = 400 strCol = "B" For i = intStart To intEnd For Each hLink In ActiveSheet.Hyperlinks hLink.TextToDisplay = Replace (hLink.TextToDisplay, "AppData/Roaming/Microsoft/Excel", "Dropbox/References") hLink.Address = Replace(hLink.Address, "AppData/Roaming/Microsoft/Excel", "Dropbox/References") Next hLink Next i End Sub
感谢您的帮助，Tim！