一键为选中单元格赋予超链接

EXCEL及VBA · 06-19

处理清单中存在的手动设置超链接报错问题

 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


VBA EXCEL