Excel Макросы: Замена текста в ячейке гиперссылкой

[virtuozo75]

Прошу помощи в создании макроса. Есть ячейки в колонке таблицы с текстовой ссылкой на картинку в интернете. Нужно в выделенных ячейках заменить эти ссылки на гиперссылки с надписью "ФОТО", если ячейка не пустая.

[Администратор]

В ячейке находится функция "ГИПЕРССЫЛКА"? Если да, то есть ли второй параметр этой функции? Этот параметр называется "имя".

[virtuozo75]

Нет, в ячейке только ссылка в виде текста. Ее и нужно превратить в гиперссылку с надписью "ФОТО". То есть, как я понимаю, вместо текста в ячейке вставить функцию ГИПЕРССЫЛКА, и ей передать в параметры: ссылка - текст из ячейки, содержащий ссылку; имя - ФОТО.

[Администратор]

В экселе гиперссылки двух видов:
1) в виде функции "гиперссылка"
2) вкладка "Вставка" - Гиперссылка

Вам какой вид удобнее?

[virtuozo75]

Честно говоря, не так важно. Главное, чтобы при клике на ячейку открывался браузер с указанным адресом. Ну и чтобы это работало и в старых версиях Excel. А вообще, если можно, то рассмотрел бы оба варианта.

[Администратор]

Макрос работает с выделенными ячейками, в которых есть значения. Ячейки с формулами макрос не обрабатывает.

Использование функции "гиперссылка"

Sub Макрос1()
   
    ' Использование функции "гиперссылка".
   
    Dim sel As Range, cel As Range
   
    '1. Отключение монитора (для ускорения макроса).
    Application.ScreenUpdating = False
    '2. Vba-именование выделенных ячеек, в которых есть значения (то есть не формулы).
        ' Чтобы не просматривать пустые ячейки.
    Set sel = Selection.SpecialCells(xlCellTypeConstants)
    '3. Вставка функции "гиперссылка".
    For Each cel In sel.Cells
        cel.Formula = "=HYPERLINK(""" & cel.Value & """," & """ФОТО"")"
    Next cel
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub

[свернуть]

Использование гиперссылки

Sub Макрос2()

    ' Использование гиперссылки.

    Dim sel As Range, cel As Range
   
    '1. Отключение монитора (для ускорения макроса).
    Application.ScreenUpdating = False
    '2. Vba-именование выделенных ячеек, в которых есть значения (то есть не формулы).
        ' Чтобы не просматривать пустые ячейки.
    Set sel = Selection.SpecialCells(xlCellTypeConstants)
    '3. Вставка гиперссылки.
    For Each cel In sel.Cells
        cel.Hyperlinks.Add Anchor:=cel, Address:=cel.Value, TextToDisplay:="ФОТО"
    Next cel
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub

[свернуть]

[virtuozo75]

Большое спасибо!

[Анти-спам]

А как сделать, чтобы вместо слова "ФОТО" вставлялся текст из соседней ячейки (название фото)?
Я хочу использовать второй макрос.

В частности, есть многострочная текстовая таблица вида:
"Заголовок статьи" - "URL статьи"
Нужно "заголовки" сделать кликабельными

[Администратор]

Здесь внесите изменения. Я сделал для ситуации, когда столбец "Заголовок статьи" выделен (юзер выделил), а столбец"URL статьи" находится справа.

Код

'3. Вставка гиперссылки.
For Each cel In sel.Cells
    cel.Hyperlinks.Add Anchor:=cel, Address:=cel.Offset(0, 1).Value, TextToDisplay:=cel.Value
Next cel

Anchor:=cel - это ячейка, в которую надо вставить гиперссылку.
cel.Offset(0, 1).Value - это ячейка, из которой нужно взять урл (адрес веб-страницы).
TextToDisplay:=cel.Value - это ячейка, из которой нужно взять текст для ячейки, в которой будет гиперссылка.

[свернуть]

Вообще, для вашей задачи может быть нужен другой алгоритм, т.к. у вас может не быть формул в столбце "Заголовок статьи" и нет смысла использовать макрос из ответа 5, а сделать по-другому. Вам нужно работать всегда с одним и тем же столбцом, или столбец может быть в разных местах? Если столбец всегда один и тот же, то можно не выделять столбец перед запуском макроса, а указать столбец в макросе.

Просто знайте, что есть и другие способы работы со столбцом, а не именно так, как в этих макросах.

[Анти-спам]

Столбец один и тот же.

[Администратор]

Данный макрос работает со столбцами A и B. В коде видны названия столбцов, поэтому можете заменить на нужные.
Предполагается, что первая строка это шапка таблицы, а данные начинаются со строки 2.

Макрос

Sub Макрос()

    Dim lr As Long, i As Long
   

    '1. Отключение монитора (для ускорения макроса).
    Application.ScreenUpdating = False

    '2. Поиск последней строки, в которой есть данные.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "A").End(xlUp).Row

    '3. Вставка гиперссылок.
    ' Цикл по строкам со второй до последней.
    For i = 2 To lr
        ' Вставка гиперссылки.
        Cells(i, "A").Hyperlinks.Add Anchor:=Cells(i, "A"), Address:=Cells(i, "B").Value, _
            TextToDisplay:=Cells(i, "A").Value
    Next i

    '4. Включение монитора.
    Application.ScreenUpdating = True

    '5. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

[свернуть]

[Анти-спам]

Большое спасибо!