Question

我有一个用于跟踪工单的电子表格。工作表的第一列的编号从14-0001开始，并一直向下连续。这些数字被超链接到各自工单的.XLS（例如包含14-0001链接到Z：\ WorkOrders \ 14-0001-Task Name \ 14-0001-Task Name.xls的单元格）

问题是，我的计算机崩溃，当Excel恢复文件时，所有超链接都改为：

**"Z:\blah blah\WorkOrders\14-****-Task Name\14-****-Task Name.xls"**

到

**"C:\Users\blahblah\WorkOrders\14-****-Task Name\14-****-Task Name.xls"**

有数百个条目，所以我希望我可以运行一个脚本来修复所有的超链接。

下面是我在网上发现的一个脚本，据我所知，它应该按照我的意愿去做，但当我从Excel中的VB窗口运行脚本时，我得到了＃34;编译错误：参数不是可选的＆＃34;并突出显示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

这甚至是正确的脚本吗？我做错了什么？

Answer 1

试试这个：

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

Answer 2

我遇到了同样的问题，我尝试的所有宏都不适用于我。这个改编自Tim的上面和这个帖子Office Techcentre thread。在我的例子中，我的所有超链接都在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

谢谢你的帮助，蒂姆！

用于修复Excel中已损坏的超链接的脚本

2 个答案: