我试图在工作中防错电子表格。我们遇到麻烦的一件事是人们复制粘贴链接然后只是改变 RMA 编号。如果所有的链接都有相同的扩展名,这在理论上是可行的,但有些是.xls,有些是.xlsx。
我已经做到了，当 RMA 列中的一个单元格被更改时，它右侧的单元格偏移量 53 会得到一个由公共函数 GetCRRLink（）生成的超链接。
Private Sub Worksheet_Change(ByVal ChangedCells As Range)
'Some code omitted here, RMA is defined
If Not Intersect(CurrentCell, RMA) Is Nothing Then
Set CurrentCell.Offset(0, 53).Formula = GetCRRLink(CurrentCell.Value)
End If
'Some code omitted here
End Sub
'Meanwhile, in Module 1
Public Function GetCRRLink(RMA As String) As Hyperlink
On Error Resume Next
Dim TryLink As Hyperlink
Set TryLink.TextToDisplay = "CRR Form"
Set TryLink.Address = "redacted" & RMA & ".xls"
TryLink.Follow
If Err.Number = 0 Then
GetCRRLink = TryLink
Exit Function
End If
Err.Clear
Set TryLink.Address = "redacted" & RMA & ".xlsx"
TryLink.Follow
If Err.Number = 0 Then
GetCRRLink = TryLink
Exit Function
End If
Set TryLink.TextToDisplay = "Error"
GetCRRLink = TryLink
End Function
当尝试设置 TryLink 的 TextToDisplay 或 Address 属性时，我得到“编译错误：错误的参数数量或无效的属性分配”。
0
TextToDisplay和Address是 String 属性。所以只需删除Set,它只用于对象分配。这应该做的伎俩。
TryLink.TextToDisplay = "CRR Form"
TryLink.Address = "redacted" & RMA & ".xls"
...
顺便说一下，当分配TryLink作为函数结果时，您将需要Set。
0
谢谢 TimWilliams！
Private Sub Worksheet_Change(ByVal ChangedCells As Range)
'Some code omitted here, RMARange is defined, events disabled
For Each CurrentCell In ChangedCells.Cells
If Not Intersect(CurrentCell, RMARange) Is Nothing Then
If CurrentCell.Value = 0 Or CurrentCell.Value = "" Then
Call CurrentCell.Offset(0, 53).Hyperlinks.Delete
CurrentCell.Offset(0, 53).Formula = ""
Else
LinkAddress = GetCRRLink(CurrentCell)
Call ThisSheet.Hyperlinks.Add(CurrentCell.Offset(0, 53), LinkAddress, "", "", CurrentCell.Value)
End If
End If
Next
'Some code omitted here, events enabled
End Sub
'Meanwhile in Module 1...
Public Function GetCRRLink(ReadCell As Range) As String
Dim TryUrl As String
Dim RMA As String
RMA = ReadCell.Value
TryUrl = "redacted" & RMA & ".xls"
If HttpTest(TryUrl) = "OK" Then
GetCRRLink = TryUrl
Exit Function
End If
TryUrl = "" & RMA & ".xlsx"
If HttpTest(TryUrl) = "OK" Then
GetCRRLink = TryUrl
Exit Function
End If
GetCRRLink = "Error"
End Function
'Thanks TimWilliams!
Public Function HttpTest(TryUrl As String) As String
Dim FileChecker As Object
Set FileChecker = CreateObject("WinHttp.WinHttpRequest.5.1")
Call FileChecker.SetAutoLogonPolicy(0)
With FileChecker
.Open "GET", TryUrl, False
.Send
HttpTest = .statusText
End With
End Function
本站系公益性非盈利分享网址，本文来自用户投稿，不代表边看边学立场，如若转载，请注明出处
评论列表（10条）