Как получить адрес гиперссылки из ячейки

Function Get_Hyperlink_Address(ByVal rCell As Range) As String
    Dim s As String
    If rCell.Hyperlinks.Count = 0 Then
        s = rCell.Formula
        If Mid$(s, 2, 9) = "HYPERLINK" Then
            'такой подход сработает только в случае, если в ячейке записана ссылка текстом
            'но не сработает, если гиперссылка создана из ссылок на ячейки
            '   Get_Hyperlink_Address = Mid$(s, 13, InStr(13, s, Chr(34)) - 13)
            'поэтому используем более сложный, но универсальный вариант
            If s Like "=HYPERLINK*" Then
                'получаем данные первого аргумента и убираем знак =
                s = Split(s, ",")(0)
                s = Mid$(s, 2, Len(s) - 1)
                'на всякий случай добавляем скобку в конец формулы
                'хоть Evaluate должен сработать и без неё
                If Right$(s, 1) <> ")" Then
                    s = s & ")"
                End If
                Get_Hyperlink_Address = Evaluate(s)
            End If
        Else
            Get_Hyperlink_Address = ""
        End If
    Else
        s = rCell.Hyperlinks(1).SubAddress
        If s <> "" Then s = "#" & rCell.Hyperlinks(1).SubAddress
        Get_Hyperlink_Address = rCell.Hyperlinks(rCell.Hyperlinks.Count).Address & s
    End If
End Function

Function Get_Hyperlink_Address(ByVal rCell As Range) As String Dim s As String If rCell.Hyperlinks.Count = 0 Then s = rCell.Formula If Mid$(s, 2, 9) = "HYPERLINK" Then 'такой подход сработает только в случае, если в ячейке записана ссылка текстом 'но не сработает, если гиперссылка создана из ссылок на ячейки ' Get_Hyperlink_Address = Mid$(s, 13, InStr(13, s, Chr(34)) - 13) 'поэтому используем более сложный, но универсальный вариант If s Like "=HYPERLINK*" Then 'получаем данные первого аргумента и убираем знак = s = Split(s, ",")(0) s = Mid$(s, 2, Len(s) - 1) 'на всякий случай добавляем скобку в конец формулы 'хоть Evaluate должен сработать и без неё If Right$(s, 1) <> ")" Then s = s & ")" End If Get_Hyperlink_Address = Evaluate(s) End If Else Get_Hyperlink_Address = "" End If Else s = rCell.Hyperlinks(1).SubAddress If s <> "" Then s = "#" & rCell.Hyperlinks(1).SubAddress Get_Hyperlink_Address = rCell.Hyperlinks(rCell.Hyperlinks.Count).Address & s End If End Function

Function Get_Hyperlink_Title(ByVal rCell As Range) As String
    Dim s As String
    If rCell.Hyperlinks.Count = 0 Then
        If Mid$(rCell.Formula, 2, 9) = "HYPERLINK" Then
            Get_Hyperlink_Title = rCell.Text
        Else
            Get_Hyperlink_Title = ""
        End If
    Else
        Get_Hyperlink_Title = rCell.Hyperlinks(1).ScreenTip
    End If
End Function

Function Get_Hyperlink_Title(ByVal rCell As Range) As String Dim s As String If rCell.Hyperlinks.Count = 0 Then If Mid$(rCell.Formula, 2, 9) = "HYPERLINK" Then Get_Hyperlink_Title = rCell.Text Else Get_Hyperlink_Title = "" End If Else Get_Hyperlink_Title = rCell.Hyperlinks(1).ScreenTip End If End Function