TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub EditLink()
' Edit links of some types
' Little error checking.  It works or not.  No harm if not.

    Dim sLinkSource As String
    Dim sOriginalLinkSource As String

    If ActiveWindow.Selection.ShapeRange.Count <> 1 Then
      MsgBox ("Please select one and only one shape, then try again.")
      Exit Sub
    End If

    With ActiveWindow.Selection.ShapeRange(1)
        'MsgBox .LinkFormat.SourceFullName
        sOriginalLinkSource = .LinkFormat.SourceFullName
        sLinkSource = InputBox("Edit the link", "Link Editor", sOriginalLinkSource)

        If sLinkSource = sOriginalLinkSource Then
            ' nothing changed; our work on this planet is done
            Exit Sub
        End If
        If sLinkSource = "" Then
            ' The user canceled; quit:
            Exit Sub
        End If

        ' Get the filename portion of the link in case it's a link to a range
        Debug.Print Mid$(sLinkSource, 1, InStr(sLinkSource, ".") + 3)

        ' Is it a valid filename?  Is the file where it belongs?
        ' Test against the filename portion of the link in case the link includes
        ' range information
        If Dir$(Mid$(sLinkSource, 1, InStr(sLinkSource, ".") + 3)) <> "" Then
            .LinkFormat.SourceFullName = sLinkSource
            .LinkFormat.Update
        Else
            MsgBox "Can't find " & sLinkSource
        End If

    End With

End Sub

If you want to edit the Hyperlink Address of a shape's Action Setting, you can use the built-in editing features in PPT or use this macro intead:

Sub EditHyperLink()
' Edit hyperlink
' Little error checking. It works or not. No harm if not.


    Dim sAddress As String
    Dim sSubAddress As String
    Dim sTemp As String

    If ActiveWindow.Selection.ShapeRange.Count <> 1 Then
        MsgBox ("Please select one and only one shape, then try again.")
        Exit Sub
    End If

    With ActiveWindow.Selection.ShapeRange(1)
        ' you can substitute or repeat the process with .SubAddress if needed
        sAddress = .ActionSettings(ppMouseClick).Hyperlink.Address

        ' Get new address
        sTemp = InputBox("Edit the link address", "Link Editor", sAddress)

        If sTemp = sAddress Then
            ' nothing changed; our work on this planet is done
            Exit Sub
        End If
        If sTemp = "" Then
            ' The user canceled; quit:
            Exit Sub
        End If

        ' No tests for existence of file since it might be a URL or .... who knows what
        ' Just replace it
        .ActionSettings(ppMouseClick).Hyperlink.Address = sTemp

    End With

End Sub