Обновите гиперссылки с помощью макроса Excel

Question

введите здесь описание изображения Я пытаюсь добавить расширение ко всем встроенным гиперссылкам на листе Excel. Я записал макрос, выполняя по одной ячейке за раз, но это неэффективно. Может ли кто-нибудь помочь мне упростить макрос, чтобы он знал, что нужно смотреть на все гиперссылки, открывать и вставлять дополнительную информацию в конце существующей гиперссылки.

Sub Macro5()
'
' Macro5 Macro
' test
'
' Keyboard Shortcut: Ctrl+Shift+H
'
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "?u=76208058&auth=true"
    Range("C2").Select
    Selection.Hyperlinks(1).Address = _
        "https://www.linkedin.com/learning/teaching-techniques-classroom-management?u=76208058&auth=true"
    Range("C3").Select
    Selection.Hyperlinks(1).Address = _
        "https://www.linkedin.com/learning/learning-how-to-increase-learner-engagement?u=76208058&auth=true"
    Range("C4").Select
    Selection.Hyperlinks(1).Address = _
        "https://www.linkedin.com/learning/teaching-with-technology?u=76208058&auth=true"
End Sub

Answer 1

Добавить строку в гиперссылки

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

Код

Option Explicit

' For the whole sheet:
Sub addTailSheet()

' Keyboard Shortcut: Ctrl+Shift+H

    Const SheetName As String = "Sheet1"
    Const TailCell As String = "H1"

    Dim ws As Worksheet
    Dim hyp As Hyperlink
    Dim Tail As String

    Set ws = ThisWorkbook.Worksheets(SheetName)

    With ws
        Tail = .Range(TailCell).Value
        For Each hyp In .Hyperlinks
            If Right(hyp.Address, Len(Tail)) <> Tail Then
                hyp.Address = hyp.Address & Tail
            End If
        Next
    End With

    MsgBox "Hyperlinks modified."

End Sub

' For a column:
Sub addTailColumn()

' Keyboard Shortcut: Ctrl+Shift+H

    Const SheetName As String = "Sheet1"
    Const TailCell As String = "H1"
    Const TailColumn As Variant = "C"  ' e.g. "C" or 3

    Dim ws As Worksheet
    Dim hyp As Hyperlink
    Dim Tail As String

    Set ws = ThisWorkbook.Worksheets(SheetName)

    With ws.Columns(TailColumn)
        Tail = .Parent.Range(TailCell).Value
        For Each hyp In .Hyperlinks
            If Right(hyp.Address, Len(Tail)) <> Tail Then
                hyp.Address = hyp.Address & Tail
            End If
        Next
    End With

    MsgBox "Hyperlinks modified."

End Sub