Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | Гиперссылки


Rambler's Top100


Counter CO.KZ


  1. Как программно создать гиперссылку ? 20.02.2007
  2. Как программно создать гиперссылки, используя текст ячейки ? NEW 14.07.2016
  3. Как сделать так, чтобы при наведении курсора мышки на гиперссылку, появлялась подсказка ? NEW 16.07.2016
  4. Как программно удалить все гиперссылки в нужном рабочем листе ? 31.03.2007
  5. Как программно создать кнопку на панели инструментов, которая будет действовать как гиперссылка ? 05.10.2007
  6. Как программно заменить текст всех гиперссылок на адреса ? 18.03.2011
  7. Как программно перебрать гиперссылки только в определённом диапазоне ? 11.04.2012
  8. Как программно определить "пересекаются" или нет графические об'екты - гиперссылки, с конкретным диапазоном ? NEW 14.05.2016
  9. Как программно определить содержит ли ячейка гиперссылку ? NEW 22.07.2016
  10. Как заменить все адреса гиперссылок, содержащие ненужные URL на необходимый адрес ? 11.04.2012
  11. Как получить список последних файлов и/или электронной почты, которые были использованы при создании гиперссылок ? NEW 15.05.2016
  12. Как программно открыть URL гиперссылку в браузере по умолчанию (WinAPI) ? 06.03.2012
  13. Как получить абсолютную гиперссылку из относительной (WinAPI) ? 13.04.2012
  14. Как программно создать относительную гиперссылку (WinAPI) ? 13.04.2012
  15. Как проверить можно ли использовать текст как адрес гиперссылки (WinAPI) ? NEW 16.07.2016
  16. Как получить список файлов/папок из буфера обмена и создать гиперссылки (WinAPI) ? NEW 29.07.2016
  17. Как создать гиперссылки на все папки (включая вложенные) и файлы, причём, учитывая их иерархию ? NEW 31.07.2016
  18. Как осуществить переход по гиперссылке с помощью клавиши ENTER ? 11.04.2012
  19. Как после ввода, автоматически менять интернет адрес на гиперссылку ? 30.09.2011
  20. Как получить или изменить базовый адрес гиперссылки текущей рабочей книги ? 15.04.2012
  21. Как отловить переход по гиперссылке и определить адрес ячейки с этой гиперссылкой ? 28.03.2012
  22. Как после ввода вручную, избежать преобразования интернет адреса или сетевого пути - в гиперссылку ? NEW 28.06.2016
  23. Как открыть в проводнике папку, где расположена рабочая книга ? 11.02.2007
  24. Как создать гиперссылку с помощью пользовательской функции ? 08.04.2012

  • Ответ : Актуально для MS Excel 97, 2000, XP

    Вариант I, II, III.
  • With ThisWorkbook.Worksheets(1)
         .Hyperlinks.Add Anchor:=.Range("A1"), Address:="http://www.msoffice.nm.ru"
    End With
    With ThisWorkbook.Worksheets(1).Range("A3")
         .Hyperlinks.Add Anchor:=.Item(1), Address:="www.nm.ru"
    End With
    With ThisWorkbook.Worksheets(1).Range("A5")
         .Hyperlinks.Add Anchor:=.Cells(1), _
         Address:=Application.DefaultFilePath
    End With
    ThisWorkbook.Worksheets(1).Range("A7").Formula = "=HYPERLINK(""mailto:Klimov.Pavel@GMail.com"")"
    Если необходимо, чтобы в ячейке отображался не адрес гиперссылки, а нужный текст, то :
    With ThisWorkbook.Worksheets(1)
         .Hyperlinks.Add Anchor:=.Range("A1"), Address:="http://www.nm.ru"
         .Range("A1").Value = "Проект Новая почта"
    End With
    With ThisWorkbook.Worksheets(1).Range("A3")
         .Hyperlinks.Add Anchor:=.Item(1), Address:="http://www.nm.ru"
         .Value = "Проект Новая почта"
    End With
    With ThisWorkbook.Worksheets(1).Range("A5")
         .Hyperlinks.Add Anchor:=.Cells(1), _
          Address:=Application.DefaultFilePath
         .Formula = "Просмотр содержимого папки"
    End With
    With ThisWorkbook.Worksheets(1).Range("A7").Formula = "=HYPERLINK(""http://www.msoffice.nm.ru"",""Может посетим ..."")"
    Особенности MS Excel 2000, XP
    В этих версиях, создать нужный текст, можно используя необязательный аргумент TextToDisplay :
    Worksheets(1).Hyperlinks.Add Anchor:=Range("C3"), _
    Address:="http://www.gramota.ru/", TextToDisplay:="Грамота.ру"

  • Ответ : Актуально для MS Excel 97(и старше)

    Для того, чтобы с помощью VBA создать гиперссылку, используя текст ячейки, достаточно использовать любой из вышеопубликованных вариантов [FAQ194] Однако, если речь идёт о диапазоне ячеек, то в этом случае необходимо добавить ещё и цикл.
  • Private Sub CreateHypelinkInTextCell()
        Dim iCell As Range
        For Each iCell In [A1:A10]
            iCell.Hyperlinks.Add iCell, iCell.Text
        Next
    End Sub
    Если в указанном диапазоне, где могут наличествовать ещё и пустые ячейки, которые, разумеется, необходимо игнорировать, то в этом случае :
    Private Sub CreateHypelinkInTextCellv2()
        Dim iCell As Range, iText$
        For Each iCell In [A1:A10]
            iText = iCell.Text
            If iText <> "" Then iCell.Hyperlinks.Add iCell, iText
        Next
    End Sub
    Комментарий : Если исходный диапазон будет насчитывать большее количество ячеек, то на время создания гиперссылок, имеет смысл отключить обновление экрана [FAQ43]

    Примечание : Если ячейки исходного диапазона могут содержать текст, который не может быть использован в качестве адреса гиперссылки, то тогда необходимо внести соответствующие изменения. Например, если речь идёт о адресах интернета, то можно проверять начинается ли текст с http
    Private Sub CreateHypelinkInTextCellv3()
        Application.ScreenUpdating = False
        Dim iCell As Range, iText$
        For Each iCell In [A1:A300]
            iText = iCell.Text
            If iText Like "http*" Then iCell.Hyperlinks.Add iCell, iText
        Next
        Application.ScreenUpdating = True
    End Sub
    Если же ячеек, содержащих интернет адреса, относительно немного, а диапазон, наоборот, может насчитывать большое количество ячеек, то можно использовать обычный поиск, т.е.
    Private Sub CreateHypelinkInTextCell2()
        Dim iSource As Range, iCell As Range, iAddress$
        Set iSource = ActiveSheet.UsedRange
        Set iCell = iSource.Find("http*", , xlValues, xlWhole)

        If Not iCell Is Nothing Then
           Application.ScreenUpdating = False
           iAddress = iCell.Address
           Do
                iCell.Hyperlinks.Add iCell, iCell.Text
                Set iCell = iSource.FindNext(iCell)
           Loop While iCell.Address <> iAddress
        Application.ScreenUpdating = True
        End If
    End Sub

  • Ответ : Актуально для MS Excel 97(и старше)

    Вариант I. Для того, чтобы создать подсказку, которая будет автоматически появляться сразу после наведения курсора мышки на гиперссылку, достаточно просто создать комментарий (примечание) с необходимым текстом.

    Примеры их создания, можно найти в соответствующем разделе и ответе, но если вкратце, то :
  • With Range("A1")
         .Hyperlinks.Add Anchor:=.Item(1), Address:="http://www.msoffice-nm.ru"
         .ClearComments '.ClearNotes
         With .AddComment(Text:="Сюда переехал www.msoffice.nm.ru").Shape.TextFrame
              .Characters.Font.Bold = True
              .AutoSize = True
         End With
         .Columns.AutoFit
    End With
    Комментарий :
  • Плюсом этого варианта, является возможность изменения параметров форматирования подсказки. Например, Вы можете установить нужный шрифт и/или его размер.
  • Минусом, безусловно, станет отсутствие подсказки на экране, если пользователь вручную или программно установит опцию Сервис - Параметры - Вид - Примечания - Не отображать

    Актуально для MS Excel 2000(и старше)

    Вариант II. В этой версии уже можно обойтись без посредника, ибо у метода .Add об'екта Hyperlinks появился новый необязательный аргумент ScreenTip
  • Range("A1").Hyperlinks.Add Anchor:=Range("A1"), Address:="http://www.msoffice-nm.ru", ScreenTip:="Сюда переехал www.msoffice.nm.ru"
    A у об'екта Hypelink появилось новое свойство ScreenTip , т.е. если гиперссылка уже существует :
    Range("A1").Hyperlinks(1).ScreenTip = "Текст нашей подсказки"

  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP
  • Private Sub DeleteAllHyperlinks()
        With ThisWorkbook.Worksheets(1)
             If Not .ProtectContents Then
                Dim iCell As Range: .Hyperlinks.Delete
                Set iCell = .UsedRange.Find(What:="=*HYPERLINK(*)", _
                LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=True)
                Do Until iCell Is Nothing
                   iCell.Style = "Normal"
                   iCell.Value = iCell.Value
                   Set iCell = .UsedRange.FindNext
                Loop
             Else
                MsgBox "Снимите защиту листа", vbExclamation, ""
             End If
        End With
    End Sub
    Примечание : Если удаление гиперссылок должно происходить в активном рабочем листе, то просто замените ThisWorkbook.Worksheets(1) на ActiveSheet

    Комментарий :
  • Удаление гиперссылок не приводит к удалению текста гиперссылок. Если такое положение вещей недопустимо, то используйте перебор всех гиперссылок, только учтите, что гиперссылка может быть связана не только с ячейкой, но и с автофигурой/рисунком.
  • Если гиперссылок, созданных с использованием стандартной функции рабочего листа =ГИПЕРССЫЛКА() может быть довольно много и/или Вы используете событие Worksheet_Change() (или аналогичное событие рабочей книги, приложения), а также Volatile функции, то в этом случае, имеет смысл использовать свойства ScreenUpdating, EnableEvents, Calculation об'екта Application. Пример их использования можно увидеть здесь.

    Актуально для MS Excel 2010
    Согласно информации, опубликованной на официальном сайте, в этой версии у об'екта Range появился метод .ClearHyperlinks, который удаляет только гиперссылки, а текст и форматирование, оставляет без изменений.
  • Ответ :

    Для того, чтобы создать кнопку - гиперссылку, можно использовать нижеприведённый код, который желательно разместить в стандартном модуле.
  • Private Sub CreateButtonHyperlink()
        With Application.CommandBars(1).Controls.Add(Type:=msoControlButton)
             .FaceId = 2083
             .OnAction = "MyHyperlink"
             .Caption = "Microsoft Excel"
             .TooltipText = "Посетить сайт"
             .Style = msoButtonIconAndCaption
        End With
    End Sub

    Private Sub MyHyperlink()
        On Error Resume Next
        ThisWorkbook.FollowHyperlink _
        Address:="http://www.msoffice.nm.ru", NewWindow:=True
    End Sub
    Актуально только для MS Excel 2000, XP
    В этой версии, решить поставленную задачу, вполне можно и без использования макросов [FAQ] , но если создание такой кнопки это только часть задачи, где применение макросов действительно имеет смысл, то :
    Private Sub CreateButtonHyperlink_XP()
        With Application.CommandBars(1).Controls.Add(Type:=msoControlButton)
             .FaceId = 2083
             .Caption = "Microsoft Excel"
             .Style = msoButtonIconAndCaption
             .TooltipText = "http://www.msoffice.nm.ru"
             .HyperlinkType = msoCommandBarButtonHyperlinkOpen
        End With
    End Sub
    Примечание :
  • - В качестве примера выбрана стандартная панель инструментов ("Строка меню листа")
  • - Вместо номера/индекса панели Вы можете использовать её имя, и заменить (1) на ("Worksheet Menu Bar")
  • - При использовании этих примеров убедитесь, что панель инструментов не защищена [FAQ125]
  • Ответ : Актуально для MS Excel 97, 2000, XP
  • Private Sub HyperlinkReplaceValueOnAddress() 'Excel97 (и старше)
        Application.ScreenUpdating = False
        Dim iHyperlink As Hyperlink
        For Each iHyperlink In Worksheets(1).Hyperlinks
            If iHyperlink.Type = msoHyperlinkRange Then _
            iHyperlink.Range.Value = iHyperlink.Address '
        Next
        Application.ScreenUpdating = True
    End Sub
    Особенности MS Excel 2000, XP
    В этих версиях, заменить текст гиперссылки на её адрес, можно также используя необязательный аргумент TextToDisplay :
    Private Sub HyperlinkReplaceValueOnAddress2() 'Excel2000 (и старше)
        Application.ScreenUpdating = False
        Dim iHyperlink As Hyperlink
        For Each iHyperlink In Worksheets(1).Hyperlinks
            If iHyperlink.Type = msoHyperlinkRange Then _
            iHyperlink.TextToDisplay = iHyperlink.Address
        Next
        Application.ScreenUpdating = True
    End Sub
    Комментарий : Если рабочий лист + ячейки защищены, то Вы получите ошибку, которую можно избежать, если использовать данный совет [FAQ42] применительно к первому варианту.
  • Ответ : Актуально для MS Excel 97, 2000, XP
  • Private Sub objectHyperlink()
        Dim iSource As Range, iHyperlink As Hyperlink, iText$
        Set iSource = ThisWorkbook.Worksheets(1).Range("A1:C1000")
        
        For Each iHyperlink In iSource.Hyperlinks
            With iHyperlink
                 iText = "Cell Value : " & CStr(.Range.Value)
                 iText = iText & vbLf & "Name : " & .Name
                 iText = iText & vbLf & "Address : " & .Address
                 iText = iText & vbLf & "SubAddress : " & .SubAddress
                 'iText = iText & vbLf & "TextToDisplay : " & .TextToDisplay
                 'iText = iText & vbLf & "ScreenTip : " & .ScreenTip
                 iText = "В ячейке " & .Range.Address & _
                 " находится гиперссылка :" & String(2, 10) & iText
            End With
            MsgBox iText, , ""
        Next
    End Sub
    Комментарий :
  • Для того, чтобы перебрать гиперссылки, созданные с помощью стандартной функции рабочего листа =ГИПЕРССЫЛКА(), используйте поиск (т.е. методы Find и FindNext)
  • Да, и обратите внимание на то, что свойства TextToDisplay и ScreenTip появились только в Excel 2000
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Для того, чтобы с помощью VBA перебрать гиперссылки только в определённом диапазоне, можно воспользоваться предыдущим советом. Однако, если речь идёт о гиперссылках, которые связаны с графикой, то для того, чтобы определить, какие из фигур/рисунков "пересекаются" с нужным диапазоном, придётся использовать другой подход, например :
  • Private Sub IntersectHLGraphAndRange()
        Dim iList As Worksheet, iSource As Range
        Dim iHyperlink As Hyperlink, iGraph As Shape
    
        Set iList = Worksheets(1)        'Лист1
        Set iSource = iList.Range("C:C") 'Лист1.[C:C]
    
        For Each iHyperlink In iList.Hyperlinks
            If iHyperlink.Type = msoHyperlinkShape Then
               Set iGraph = iHyperlink.Shape
    
               If Not Intersect(iSource, iList.Range( _
               iGraph.TopLeftCell, iGraph.BottomRightCell)) Is Nothing Then
                  MsgBox "Пересеклись", , iGraph.Name
               End If
            End If
        Next
    End Sub

  • Ответ : Актуально для MS Excel 97, 2000, XP

    Для того, чтобы с помощью VBA определить, связана ли ячейка с гиперссылкой, в т.ч. созданной с помощью стандартной функцией рабочего листа =ГИПЕРССЫЛКА() , можно использовать нижеопубликованную функцию.
  • Public Function IsHyperlink(Cell As Range) As Boolean
        IsHyperlink = _
        Cell.Hyperlinks.Count > 0 Or Cell.Formula Like "=*HYPERLINK(*)"
    End Function
    Комментарий : Если формула в ячейке скрыта (см. Формат - Ячейки - Защита - Скрыть формулы), а рабочий лист защищён (см. Сервис - Защита - Защитить лист), то возникнет ошибка.
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Предположим, что во всех рабочих листах - текущей рабочей книги, нам необходимо найти все гиперссылки, адреса которых содержат ненужные URL ссылки, в данном примере, это URL поисковиков, которые, к сожалению, либо прекратили своё существование, либо приостановили свою деятельность, и заменить найденный адрес и текст в ячейке, на "http://www.yandex.ru" и "Яндекс. Найдётся всё", соответственно.
  • Private Sub ReplaceChooseHyperlinks()
        Dim iWorksheet As Worksheet, iHyperlink As Hyperlink, iArray
        
        iArray = Array("turtle.ru", "punto.ru", "webfind.ru")
        
        With Application
             .ScreenUpdating = False
             .EnableEvents = False
             .Calculation = xlManual
             For Each iWorksheet In ThisWorkbook.Worksheets
                 For Each iHyperlink In iWorksheet.Hyperlinks
                     If .Count(.Search(iArray, iHyperlink.Address)) Then
                        iHyperlink.Address = "http://www.yandex.ru"
                        If iHyperlink.Type = msoHyperlinkRange Then
                           iHyperlink.Range.Value = "Яндекс. Найдётся всё"
                           'iHyperlink.TextToDisplay = "Яндекс. Найдётся всё"
                        End If
                     End If
                 Next
             Next
             .Calculation = xlAutomatic
             .EnableEvents = True
             .ScreenUpdating = True
        End With
    End Sub
    Комментарий :
  • Если рабочий лист + ячейки защищены, то при использовании Range.Value Вы получите ошибку, которую можно избежать, если использовать данный совет [FAQ42]
  • Для того, чтобы перебрать гиперссылки, созданные с помощью стандартной функции рабочего листа =ГИПЕРССЫЛКА(), используйте поиск (т.е. метод Find и FindNext)
  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Для того, чтобы получить перечень всех последних файлов и адресов электронной почты, которые были использованы при создании гиперссылок, можно использовать нижеопубликованный макрос. Обратите внимание на то, что его тестирование проводилось исключительно на машинах с OC Windows XP.
  • Private Sub RegArchiveHyperlinks()
         Const Reg = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\TypedURLs\URL"
    
         On Error GoTo ErrHandler
    
         With CreateObject("WScript.Shell")
              Do
                 iCount% = iCount% + 1
                 tmp$ = .RegRead(Reg & iCount%)
                 If tmp$ Like "mailto:*" Then '"mailto:*@*.*"
                    MsgBox "Почта : " & tmp$
                 Else
                    MsgBox "Файл : " & tmp$
                 End If
              Loop
         End With     
    ErrHandler: End Sub

  • Ответ : Актуально для MS Excel XP (и старше)

    Если активная ячейка содержит гиперссылку, то в Excel 97, 2000 переход по гиперссылке можно осуществить, просто нажав клавишу ENTER, в следующих же версиях, такая возможность исчезла, и если Вы хотите её вернуть, то скопируйте в любой стандартный модуль личной книги макросов "Personal.xls" нижеприведённый код и сохраните изменения :
  • Private Sub Auto_Open()
        Application.OnKey "~", "FollowHyperlink"
        Application.OnKey "{ENTER}", "FollowHyperlink"
    End Sub
    
    Private Sub FollowHyperlink()
        If Not TypeOf Selection Is Range Then Exit Sub
           
        If ActiveCell.Hyperlinks.Count = 0 Then
           If Not Application.MoveAfterReturn Then Exit Sub
           
           Select Case Application.MoveAfterReturnDirection
               Case xlDown:    SendKeys "{DOWN}"
               Case xlToLeft:  SendKeys "{LEFT}"
               Case xlToRight: SendKeys "{RIGHT}"
               Case xlUp:      SendKeys "{UP}"
           End Select
        Else
           On Error Resume Next
           ActiveCell.Hyperlinks(1).Follow 'NewWindow:=True
        End If
    End Sub
    Комментарий : Этот вариант не будет работать с гиперссылками, созданными с помощью стандартной функции рабочего листа =ГИПЕРССЫЛКА()
  • Ответ : Актуально для MS Excel 97

    Если Вы работаете с Excel 97, то возможно замечали, что в 8-й версии (в отличии от последующих) после ввода (или редактирования) текста, начинающегося с http:// , www. , ftp. , mailto: автоматического создания гиперссылок не происходит. Если такая ситуация неприемлема и Вам просто необходимо автоматизировать создание гиперссылок, причём только в определённом диапазоне, то выберите наиболее подходящий вариант, и разместите его в модуле нужного рабочего листа [FAQ31]

    Сокращённая версия (только ввод URL адресов, начинающихся с http:// или www.)
  • Option Compare Text
    
    Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'XL97
        Dim iSource As Range, iCell As Range
        Set iSource = Intersect(Target, [A2:A100])
        If Not iSource Is Nothing Then
           For Each iCell In iSource
               If iCell.Text Like "www.*" Then
                  Hyperlinks.Add Anchor:=iCell, Address:="http://" & iCell
               ElseIf iCell.Text Like "http://*" Then
                  Hyperlinks.Add Anchor:=iCell, Address:=iCell
               End If
           Next
        End If
    End Sub
    Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'XL97
        Dim iSource As Range, iCell As Range
        Set iSource = Intersect(Target, [A2:A100])
        If Not iSource Is Nothing Then
           For Each iCell In iSource
               If InStr(1, iCell, "www.", vbTextCompare) = 1 Then
                  Hyperlinks.Add Anchor:=iCell, Address:="http://" & iCell
               ElseIf InStr(1, iCell, "http://", vbTextCompare) = 1 Then
                  Hyperlinks.Add Anchor:=iCell, Address:=iCell
               End If
           Next
        End If
    End Sub
    Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'XL97
        Dim iSource As Range, iCell As Range, iText$
        Set iSource = Intersect(Target, [A2:A100])
        If Not iSource Is Nothing Then
           If Application.Sum(Application.CountIf( _
              iSource, Array("http://*", "www.*"))) = 0 Then
              'MsgBox "В этом диапазоне нет URL адресов", vbInformation, ""
              Exit Sub
           End If
           For Each iCell In iSource
               iText = LCase(CStr(iCell))
               Select Case True
                   Case iText Like "www.*"
                   Hyperlinks.Add Anchor:=iCell, Address:="http://" & iText
                   Case iText Like "http://*"
                   Hyperlinks.Add Anchor:=iCell, Address:=iText
               End Select
           Next
        End If
    End Sub
    Полная версия (включает также создание гиперссылок, типа info@mail.ru , mailto:admin@xxx.ru)
    Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'XL97
        Dim iSource As Range, iCell As Range, iAddress$
        Set iSource = Intersect(Target, Me.[A2:A100])
        If iSource Is Nothing Then Exit Sub
           
        iArrPrefix = Array("http://*", "ftp.*", "www.*", "mailto:*", "*@*.*")
        With Application
             If .Sum(.CountIf(Target, iArrPrefix)) = 0 Then Exit Sub
             '.ScreenUpdating = False
             For Each iCell In iSource
                 iIndexPrefix = .Match(1, .CountIf(iCell, iArrPrefix), 0)
                 If Not IsError(iIndexPrefix) Then
                    iAddress = Choose(iIndexPrefix, "", _
                    "ftp://", "http://", "", "mailto:") & iCell.Value
                    Me.Hyperlinks.Add Anchor:=iCell, Address:=iAddress
                 End If
             Next
             '.ScreenUpdating = True
        End With
    End Sub

  • Ответ : Актуально для MS Excel 97, 2000, XP

    Для того, чтобы с помощью VBA, получить или изменить путь/адрес, который Excel использует для создания относительных гиперссылок (и который можно увидеть/изменить вручную, если в меню Файл выбрать команду Свойства, затем выделить закладку Документ и работать с текстовым полем База гиперссылки), достаточно применить следующий синтаксис, разумеется, указав нужную рабочую книгу.
  • iPath = ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base")
    If iPath <> "" Then
       MsgBox "База гиперссылки: " & iPath, ,""
    Else
       MsgBox "На нет, и суда нет", ,""
    End If
    Комментарий : Обратите внимание на то, что в случае отсутствия базы гиперссылки, гиперссылки, типа, file:// могут создаваться относительно папки, в которой находится текущая книга (естественно, если она сохранена)
    iPath = "C:\Мои документы"
    ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base") = iPath
    iAddress = "http://www.microsoft.com"
    ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base") = iAddress

  • Ответ : Актуально для MS Excel 2000, XP

    Для того, чтобы отловить клик мышкой (или нажатие клавиши ENTER в Excel 2000) по гиперссылке, а также определить адрес ячейки с этой гиперссылкой, можно использовать нижеприведённое событие, которое необходимо разместить в модуле нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
        Dim iCell As Range
        Set iCell = Target.Range 'Target.Parent
        MsgBox iCell.Address
    End Sub
    А для того, чтобы отловить клик мышкой по фигуре/рисунку, которым назначена гиперссылка, можно вместо создания гиперссылки, создать макрос, который будет осуществлять переход по нужной ссылке и который необходимо будет назначить этой фигуре/рисунку.

    Если же об'екты-гиперссылки уже созданы и создавать имитации вручную уже затруднительно, то ниже опубликован макрос, который сохранит текст гиперссылки в виде замещающего web текста и назначит таким об'ектам процедуру MacrosHyperlink
    Private Sub ShapeHyperlinkReplaceMacros() 'Microsoft Excel 2000 (и старше)
        Dim iHyperlink As Hyperlink
        
        For Each iHyperlink In ActiveSheet.Hyperlinks
            If iHyperlink.Type = msoHyperlinkShape Then 'msoHyperlinkInlineShape
               With iHyperlink
                    If .Address <> "" Then
                       .Shape.AlternativeText = .Address
                    Else
                       .Shape.AlternativeText = "#" & .SubAddress
                    End If
                    .Shape.Hyperlink.Delete
                    .Shape.OnAction = "MacrosHyperlink"
               End With
            End If
        Next
    End Sub
    
    Private Sub MacrosHyperlink()
        On Error Resume Next
        
        With ActiveSheet.Shapes(Application.Caller)
             Dim iAddress$
             iAddress = .AlternativeText
             'Здесь Вы получаете доступ к фигуре, которая, по сути,
             'является имитацией гиперссылки и можете добраться до
             'её свойств и методов
        End With
    
        ActiveWorkbook.FollowHyperlink iAddress
    End Sub
    Комментарий : Обратите внимание на то, что макрос перебирает гиперссылки активного рабочего листа и выполняет замену только в том случае, если об'ект + лист не защищёны. В противном случае, при удалении гиперссылки, возникнет ошибка, которой можно избежать, если воспользоваться этим советом.

    Разумеется, Вы вправе указать любой другой рабочий лист или перебрать все рабочие листы в нужной рабочей книге. В любом случае, нужно понимать, что активный лист используется в этом примере, только в качестве демонстрации.
  • Ответ : Актуально для MS Excel XP(и старше)

    Для того, чтобы после ручного ввода интернет адреса или сетевого пути, не происходило автоматического создания гиперссылки, можно воспользоваться этим советом. Однако, если четвёртый вариант необходимо реализовать программно, то снять соответствующий "флажок", можно так :
  • Application.AutoFormatAsYouTypeReplaceHyperlinks = False

    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

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