Question

我现在已多次使用hyperlinks.add并且从未遇到任何问题。现在我添加了一行代码：SourceBook.Sheets(ESN & "_SV" & SV).Hyperlinks.Add Anchor:=Range("A" & i), _ Address:=ToPath & NewName到我的基本代码（你可以在这里找到）。这应该添加到新创建的文档的链接。

问题是excel总是说无法打开文件。我通过代码输入的链接是正确的，因为我用debug.print复制它，它打开文件没有问题。

我注意到，当我将鼠标悬停在超链接上时，我添加的超链接由excel修改。我想知道这是怎么可能的。

我遇到的第二个问题是，当我手动输入超链接并手动导航到文件以确保它采用正确的文件时，excel仍会修改我的链接并说＆＃34;无法打开指定的文件＆＃34;。

任何人都知道这里可能出现什么问题？谢谢！

代码：

`Application.ScreenUpdating = False
Dim i, j, FSO As Object, SV, ESN, PartName, ToPath, FromPath, NewName, MsgBoxAnswer, TargetBook As Workbook, SourceBook As Workbook
Dim OS, PN, SN, ProjectNumber, Customer, StartDate, EndDate, LastRowCMM
ESN = ActiveWorkbook.ActiveSheet.Range("G2").Value
SV = ActiveWorkbook.ActiveSheet.Range("K2").Value
ProjectNumber = ActiveWorkbook.ActiveSheet.Range("A3").Value
Customer = ActiveWorkbook.ActiveSheet.Range("G3").Value
Set FSO = CreateObject("scripting.filesystemobject")
PGB.Min = 0
PGB.Value = 0
PGB.Max = 22

'Create main folder
If SV <> 1 Then
SV = "(SV " & SV & ")"
ToPath = "U:\tmo\vanmolle\fiches constat\Fiches constats #" & ESN & " " & SV
Else
ToPath = "U:\tmo\vanmolle\fiches constat\Fiches constats #" & ESN
End If
If FSO.folderexists(ToPath) = True Then
MsgBoxAnswer = MsgBox("Folder already created.", vbExclamation, "Folder exists.")
Exit Sub
End If
FSO.createfolder (ToPath)


'Create all Excel files & fill them in
For i = 6 To 27
FromPath = "U:\tmo\VANMOLLE\Fiches constat\Template fiches constat LEAP.xlsm"
If SV <> 1 Then
ToPath = "U:\tmo\vanmolle\fiches constat\Fiches constats #" & ESN & " " & SV & "\"
Else
ToPath = "U:\tmo\vanmolle\fiches constat\Fiches constats #" & ESN & "\"
End If

FSO.copyfile Source:=FromPath, Destination:=ToPath
NewName = "#" & ESN & "_" & ActiveWorkbook.ActiveSheet.Range("A" & i) & ".xlsm"
If SV <> 1 Then
FromPath = "U:\tmo\vanmolle\fiches constat\Fiches constats #" & ESN & " " & SV & "\Template fiches constat LEAP.xlsm"
Else
FromPath = "U:\tmo\vanmolle\fiches constat\Fiches constats #" & ESN & "\Template fiches constat LEAP.xlsm"
End If

Name FromPath As ToPath & NewName
Set SourceBook = ThisWorkbook
Set TargetBook = Workbooks.Open(ToPath & NewName)
TargetBook.Sheets("Sheet1").Activate
PartName = SourceBook.ActiveSheet.Range("A" & i).Value
OS = SourceBook.ActiveSheet.Range("D" & i).Value
PN = SourceBook.ActiveSheet.Range("B" & i).Value
SN = SourceBook.ActiveSheet.Range("C" & i).Value
    If SN = "" Then SN = "N/A"
StartDate = SourceBook.ActiveSheet.Range("G" & i).Value
EndDate = SourceBook.ActiveSheet.Range("H" & i).Value

'check for right CMM
'LastRowCMM = TargetBook.Sheets("Révision CMM").Range("B6").End(xlDown).Row
'For j = 1 To LastRowCMM
'If PartName = TargetBook.Sheets("Révision CMM").Range("A" & j).Value Then ActiveWorkbook.ActiveSheet.Range("A23").Value = ActiveWorkbook.Sheets("Révision CMM").Range("B" & j).Value
'Next j

TargetBook.ActiveSheet.Range("B9").Value = PartName
TargetBook.ActiveSheet.Range("B10").Value = OS
TargetBook.ActiveSheet.Range("B11").Value = "# " & ESN
TargetBook.ActiveSheet.Range("B12").Value = PN
TargetBook.ActiveSheet.Range("B13").Value = SN
TargetBook.ActiveSheet.Range("E9").Value = StartDate
TargetBook.ActiveSheet.Range("E10").Value = EndDate
TargetBook.ActiveSheet.Range("B14").Value = ProjectNumber
TargetBook.ActiveSheet.Range("B15").Value = Customer
TargetBook.ActiveSheet.PageSetup.PrintArea = "$A$1:$E$39"

TargetBook.Close True

'Add hyperlink
SourceBook.Sheets(ESN & "_SV" & SV).Hyperlinks.Add Anchor:=Range("A" & i), _
Address:=ToPath & NewName

Application.Wait (Now + TimeValue("00:00:01"))
Progress.PGB.Value = i - 5
Progress.Lbl.Caption = "File " & i - 5 & " of 22 copied."
Next i
Application.ScreenUpdating = True`

Answer 1

首先 - 明确声明每个变量。 E.g：

Dim i as Long, j as Long, FSO As Object, SV as String, ESN as String等代码中的方式 - Dim i, j, SV, ESN, PartName, ToPath它们被声明为变体。

第二件事 - 尝试进一步调试的非常小的东西。例如。写下这篇小文章：

Sub TestMe()    
    With Worksheets(1)
      .Hyperlinks.Add anchor:=.Range("A1"), Address:="C:\Users\UserName\Desktop\test.docx"
    End With        
End Sub

并检查它是否有效。如果没有，请进一步调试，检查单元格是否被锁定或类似。

Hyperlinks.add更改不需要的超链接

1 个答案: