Замена гиперссылок с формулой =ГИПЕРССЫЛКА() на обычные

Иногда требуется заменить на листе все гиперссылки, созданные при помощи функции листа =ГИПЕРССЫЛКА(), на обычные гиперссылки.

В этом поможет VBA-функция FormulaHyperlink, и основанный на ней макрос:

Function FormulaHyperlink(ByRef cell As Range) As String
    If cell.HasFormula And (cell.Hyperlinks.Count = 0) Then
        If cell.Formula Like "=HYPERLINK*" Then
            FormulaHyperlink = Evaluate(Mid$(Split(cell.Formula, ",")(0), 12))
        End If
    End If
End Function

Выделите диапазон ячеек, и запустите этот макрос (не забыв добавить ниже его функцию FormulaHyperlink)

Sub ЗаменаГиперссылокСформуламиНаОбычныеВВыделенномДиапазоне()
    Dim cell As Range: Application.ScreenUpdating = False
    For Each cell In Selection ' перебираем все выделенные ячейки
        addr$ = FormulaHyperlink(cell) ' берем ссылку из формулы
        If Len(addr$) Then ' если ссылка есть, то
            cell.Value = cell.Value ' заменяем формулу значением
            cell.Hyperlinks.Add cell, addr$ ' заново прописываем гиперссылку
        End If
    Next cell
End Sub

А этот макрос заменит все гиперссылки в 3-м столбце активного листа:
(пример - в прикреплённом файле)

Sub ЗаменаГиперссылокСформуламиНаОбычные()
    Dim cell As Range, ra As Range: Application.ScreenUpdating = False
    Set ra = Range([c1], Range("c" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        addr$ = FormulaHyperlink(cell)
        If Len(addr$) Then
            cell.Value = cell.Value
            cell.Hyperlinks.Add cell, addr$
        End If
    Next cell
End Sub

Вложения:

Hyperlinks.xls

29.5 КБ

20232 просмотра

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

MVA, 21 Фев 2021 - 16:24.#1

Игорь, добрый день!
По какой-то причине, FormulaHyperlink() возвращает пустую строку, если путь содержит символ "," (comma).
=HYPERLINK("\\aa.aa\AAA\substr1, substr2\0a.0.a=a01 [aa]"; "ссылка")
При запуске макроса ЗаменаГФОВДиапазоне() возвращается ошибка `Run time 13`

Function FormulaHyperlink(ByRef cell As Range) As String
    'On Error Resume Next - позволяет пропустить строку, однако ссылка остается формульной
    If cell.HasFormula And (cell.Hyperlinks.Count = 0) Then
        If cell.Formula Like "=HYPERLINK*" Then
            FormulaHyperlink = Evaluate(Mid$(Split(cell.Formula, ",")(0), 12)) 'error string «Run time 13»
        End If
    End If
End Function

Прошу помочь и подсказать, какое необходимо добавить условие, чтобы формула не спотыкалась на запятой?

MVA, 21 Фев 2021 - 16:20.#2

Игорь (администратор сайта), 1 Мар 2018 - 19:00.#3

какие ссылки? формульные?
массив = range("a1:g10").formulaR1C1
потом обрабатываете формулы для извлечения ссылки

а если ссылки обычные, не формулой сделанные, - то никак

Гость, 1 Мар 2018 - 18:42.#4

А не подскажите как в массиве достать ссылки.
Благодарю

Игорь (администратор сайта), 1 Мар 2018 - 18:36.#5

Нет, с массивом не работает
Для простановки гиперссылок, необходимо перебирать ячейки в цикле
От того, что вы в двумерном массиве обработаете формулы, - ссылки в ячейках не появятся же..

Гость, 1 Мар 2018 - 18:20.#6

Добрый день.
А эта функция работает с двумерными массивами? Если да то как указать синтаксис без For Each cell In Selection? Спасибо

Олег, 25 Окт 2012 - 13:52.#7

Спасибо за ответ!
Уже победил, вот так:

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

Игорь (администратор сайта), 25 Окт 2012 - 13:40.#8

Здравстсвуйте, Олег.
Посмотрел ваш файл. А что там и как должно работать?

Макрос обрабатывает ссылки только в третьем столбце.
В этом столбце (в вашем файле) все гиперссылки - обычные, нет ни одной «формульной» гиперссылки
(либо там изначально не было гиперссылок на формулах, либо макрос их уже обработал)

А то, что полученные гиперссылки не работают - так они и не будут работать, ибо они взяты с сайта «как есть»,
т.е. в относительном формате (например, ссылка /catalog/detail.php?SECTION_ID=160&ELEMENT_ID=1187&ORDER=Y)
Адрес сайта не указан - потому ссылки не работают (и до обработки макросом не работали)

Впечатление такое, что вам нужен совсем не этот макрос.
А чего вы пытаетесь добиться в своем файле, - вы предпочли умолчать)

Олег, 25 Окт 2012 - 12:12.#9

Добрый день!
Не срабатывает макрос. Подставил свои ссылки в ваш файл.
narod.ru/disk/62923877001.c6801cb79c5de501b2f9e332399e55c7/Hyperlinks.xlsm.html

Игорь (администратор сайта), 27 Май 2012 - 20:38.#10

Здравствуйте, Виталий.
Способа перейти по такой гиперссылке без помощи мыша я не знаю (если, конечно, если не запустить встроенное средство Windows для управления курсором при помощи клавиатуры)

Зато макросом - это можно запросто сделать:

Sub ПереходПоГиперссылкеИзАктивнойЯчейки()
 
    ' получаем гиперссылку из активной ячейки листа
    URL$ = FormulaHyperlink(ActiveCell)
 
    ' если гиперссылка найдена - переходим по ней
    If Len(URL$) Then ThisWorkbook.FollowHyperlink URL$
 
End Sub
 
Function FormulaHyperlink(ByRef cell As Range) As String
    If cell.HasFormula And (cell.Hyperlinks.Count = 0) Then
        If cell.Formula Like "=HYPERLINK*" Then
            FormulaHyperlink = Evaluate(Mid$(Split(cell.Formula, ",")(0), 12))
        End If
    End If
End Function

Ну или предварительно замените «формульные» гиперссылки на «обычные»:
http://excelvba.ru/code/FormulaHyperlinks

Гость, 27 Май 2012 - 19:45.#11

Здравствуйте!
Меня зовут Виталий.
Буте добры подскажите каким образом можно перейти по гиперссылке написанной формулой =ГИПЕРССЫЛКА() без помощи мышки , используя клавиатуру или макрос.

Отправить комментарий

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Замена гиперссылок с формулой =ГИПЕРССЫЛКА() на обычные

Комментарии

Настройки просмотра комментариев

Отправить комментарий

НАДСТРОЙКИ ДЛЯ EXCEL