处理清单中存在的手动设置超链接报错问题
Sub 一键为选中单元格赋予超链接()
Dim cell As Range
Dim sText As String
' 遍历当前选中的单元格
For Each cell In Selection
' 如果单元格处于合并状态,则跳过
If cell.MergeCells Then
GoTo NextCell
End If
' 检查是否存在错误
If Not IsError(cell.Value) Then
sText = cell.Text
If Trim(sText) <> "" Then
' 删除已有超链接,防止重复添加
If cell.Hyperlinks.Count > 0 Then cell.Hyperlinks.Delete
' 添加超链接(空地址,触发 FollowHyperlink 事件)
cell.Hyperlinks.Add Anchor:=cell, Address:="", SubAddress:="", TextToDisplay:=sText
End If
End If
NextCell:
Next cell
MsgBox "选中单元格的超链接已设置完成!"
End Sub