mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

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

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

В этом поможет 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.xls29.5 КБ754 дня 3 часа назад

Комментарии

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

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

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

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

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

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

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

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

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

Здравствуйте, Виталий.
Способа перейти по такой гиперссылке без помощи мыша я не знаю (если, конечно, если не запустить встроенное средство 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

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

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

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
   __     _____                      _  __  __
/ /_ |_ _| __ _ __ __ (_) \ \/ /
| '_ \ | | / _` | \ \ /\ / / | | \ /
| (_) | | | | (_| | \ V V / | | / \
\___/ |_| \__,_| \_/\_/ |_| /_/\_\
Введите код, изображенный в стиле ASCII-арт.

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

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