Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню Заметки | Создание гиперссылки с помощью пользовательской функции


Rambler's Top100


Counter CO.KZ
Начиная с Microsoft Excel 97, в Вашем распоряжении, появилось несколько средств создания гиперссылок, а именно, стандартная функция рабочего листа =ГИПЕРССЫЛКА() и диалоговое окно Добавить гиперссылку, которое появится, если в меню Вставка выбрать команду Гиперссылка (или кликнуть кнопку Добавить гиперссылку на панели инструментов Стандартная или воспользоваться сочетанием клавиш CTRL + K)

Ради приличия можно добавить, что уже в Microsoft Excel 2000 одноимённая команда появилась и в контекстном меню "Ячейка"/"Cell", которое можно лицезреть, если выделить любую ячейку и кликнуть правой кнопкой мышки. Кроме того, в названии кнопки/заголовке окна произошли незначительные изменения, и, разумеется, гиперссылки стали создаваться автоматически, сразу после их непосредственного ввода в ячейку, но речь идёт о другом ... у каждого варианта, есть свои особенности (читайте плюсы и минусы) и несомненным плюсом функции =ГИПЕРССЫЛКА() является возможность "динамического" создания ссылок.

К примеру, любая из нижеопубликованных формул поможет Вам осуществить переход к последней заполненной ячейки столбца B:B , разумеется, при условии, что заполнение ячеек начинается с самой первой ячейки этого столбца, т.е. с B1 и между ячейками с данными - нет пустых ячеек.

=ГИПЕРССЫЛКА("#"&АДРЕС(СЧЁТЗ(B:B);2))
=ГИПЕРССЫЛКА("#"&АДРЕС(СЧЁТЗ(B:B);ЧИСЛСТОЛБ($A:B)))
=ГИПЕРССЫЛКА("#"&ЯЧЕЙКА("Address";ИНДЕКС(B:B;СЧЁТЗ(B:B))))


Однако, как только дело доходит до программной обработки ячеек, содержащих такие гиперссылки, то сразу "всплывают" и минусы, ибо выясняется, что невозможно "отловить" переход по этим ссылкам, с помощью события Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

кроме того, невозможно получить адрес гиперссылки, если соблюдаются следующие условия :

  • ячейка с формулой скрыта (меню Формат команда Ячейки, закладка Защита и "флажок" Скрыть формулы)
  • рабочий лист защищён в отношении содержимого (меню Сервис пункт Защита команда Защитить лист и далее)
  • используется второй(необязательный) аргумент Имя (см. нижеприведённую функцию)

    =ГИПЕРССЫЛКА("www.msoffice.nm.ru";"Заходите, гости дорогие")

    При этом, получить все свойства гиперссылок, созданных с помощью уже упомянутого диалогового окна, или с применением VBA (Hyperlinks.Add), наоборот, не представляет никакой сложности, однако, нельзя создавать "динамические" гиперcсылки (естественно, с помощью соответствующих событий, можно отслеживать изменения в определённых ячейках, и программно создавать гиперссылки, но здесь демонстрируется другой трюк) вот и получается, совсем как у классика :
    « Если бы губы Никанора Ивановича да приставить к носу Ивана Кузьмича... » Н.В.Гоголь "Женитьба"
    К счастью, в нашем случае (XL97, 2000, XP, 2003), не всё так безнадёжно, ибо мы можем просто создать имитацию стандартной функции, и вместо функции ГИПЕРССЫЛКА, вызывать из ячеек рабочего листа, пользовательскую функцию setHyperlink, которая будет создавать ссылки, используя метод Add об'екта Hyperlinks (см. листинг)
  • Public Function setHyperlink(Address, Optional AddressName)
    '*****************************************************************************'
    '          Дата создания : 20/02/2007                                         '
    '          Автор         : Климов Павел Юрьевич                               '
    '          Сайт          : http://www.msoffice.nm.ru                          '
    '          Версия Excel  : 97, 2000, XP, 2003, 2007, 2010                     '
    '*****************************************************************************'
        setHyperlink = IIf(IsMissing(AddressName), CStr(Address), AddressName)
    
        Dim iCell As Range, iCount%, iArrPrefix
        iArrPrefix = Array("http:*", "www.*", _
        "ftp:*", "ftp.*", "mailto:*", "*@*.*", "file:*", "*:*", "*..*")
    
        Set iCell = Application.Caller(1) 'Application.ThisCell
        For iCount = 0 To 8 'LBound(iArrPrefix) To UBound(iArrPrefix)
            If Address Like iArrPrefix(iCount) Then
               Address = Choose(iCount + 1, "", "http://", "", _
               "ftp://", "", "mailto:", "", "file://", "") & Address
               iCell.Hyperlinks.Add iCell, Address
               Exit Function
            End If
        Next
        iCell.Hyperlinks.Add iCell, "#" & Address
    End Function
    Public Function setHyperlink(Address, Optional AddressName)
    '*****************************************************************************'
    '          Дата создания : 20/02/2007                                         '
    '          Автор         : Климов Павел Юрьевич                               '
    '          Сайт          : http://www.msoffice.nm.ru                          '
    '          Версия Excel  : 97, 2000, XP, 2003, 2007, 2010                     '
    '*****************************************************************************'
        setHyperlink = IIf(IsMissing(AddressName), CStr(Address), AddressName)
    
        Dim iCell As Range, iCount%, iArrPrefix, iArrPrefix2
    
        iArrPrefix = Array("http:*", "www.*", _
        "ftp:*", "ftp.*", "mailto:*", "*@*.*", "file:*", "*:*", "*..*")
        iArrPrefix2 = Array("http://", "ftp://", "mailto:", "file://")
    
        Set iCell = Application.Caller(1) 'Application.ThisCell
        For iCount = 0 To 8 'LBound(iArrPrefix) To UBound(iArrPrefix)
            If Address Like iArrPrefix(iCount) Then
               If CBool(iCount Mod 2) = True Then _
               Address = iArrPrefix2(iCount \ 2) & Address
               iCell.Hyperlinks.Add iCell, Address
               Exit Function
            End If
        Next
        iCell.Hyperlinks.Add iCell, "#" & Address
    End Function
    На самом деле, имитацией стандартной функции рабочего листа =ГИПЕРССЫЛКА(), является нижеприведённая пользовательская функция, а предыдущие варианты, созданы для того, чтобы упростить ввод некоторых ссылок, так, например, почтовые адреса (E-Mail) можно вводить без префикса mailto: ; URL адреса можно вводить без префикса http://, разумеется, если указана аббревиатура World Wide Web, проще говоря www. и т.д.

    (более полное сравнение функций, можно найти в примере)
    Public Function setHyperlink(Address, Optional AddressName)
    '*****************************************************************************'
    '          Дата создания : 11/04/2012                                         '
    '          Автор         : Климов Павел Юрьевич                               '
    '          Сайт          : http://www.msoffice.nm.ru                          '
    '          Версия Excel  : 97, 2000, XP, 2003, 2007, 2010                     '
    '*****************************************************************************'
        setHyperlink = IIf(IsMissing(AddressName), CStr(Address), AddressName)
        
        With Application.Caller 'Application.ThisCell
             .Hyperlinks.Add .Item(1), Address '.Cells(1), Address
        End With
    End Function



    Пример можно скачать здесь



    Автор : Климов Павел Юрьевич
    © 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff