PowerPoint, une macro pour modifier le dossier de tous les liens hypertextes

Je souhaiterais partager avec vous aujourd’hui une macro que j’ai réaliser il y quelques jours en réponse à une question postée sur le site de la Communauté Microsoft Office.

La requête du demandeur portait sur la possibilité de changer automatiquement le dossier de destination de tous les liens hypertextes dans sa présentation.

Pour être plus claire, voici la situation exposée par notre ami.

Dans une présentation plusieurs liens hypertextes pointes vers différents fichiers sauvegardés sur un dossier Web. Exemple http://www.blabla.net/formation2010/parcours/analyse_s/Identifier/F10014.htm

On souhaite ne garder que le nom du fichier et remplacer l’ancien répertoire par un nouveau afin d’obtenir quelque chose comme ceci.
http://www.blingbling.com/formation2014/parcours-pro/analyse_s/Identifier/F10014.htm

Voici donc la macro que j’ai proposée (en espérant quelle pourra en aider plus d’un)

---------------------------------------------------- début de la macro

Sub link_switch()
    ' Macro proposée par Mehdi HAMMADI le 06/01/2015
    ' Object : MAJ automatique des tous les liens hypertextes dans une présentation
    ' Macro adaptée à partir d'une macro proposée par John Wilson

    ' (http://www.vbaexpress.com/forum/showthread.php?42916-VBA-to-change-PowerPoint-link-
      sources-to-the-Excel-file-that-opened-it)

    Dim osld As Slide
    Dim oHL As Hyperlink
    Dim strNewLink As String
    Dim strOldPath As String
    Dim strNewPath As String
    Dim strFileName As String

    strOldPath = http://www.blabla.net/formation2010/parcours/analyse_s/Identifier/
    strNewPath = "http://www.blingbling.com/formation2010/parcours/analyse_s/Identifier/"

    For Each osld In ActivePresentation.Slides

        For Each oHL In osld.Hyperlinks

            strFileName = Right(oHL.Address, Len(oHL.Address) - Len(strOldPath))
            strNewLink = strNewPath & strFileName

            If oHL.Type = msoHyperlinkRange Then
                oHL.TextToDisplay = strNewLink
            Else
                oHL.Address = strNewLink
            End If

         Next oHL

    Next osld

End Sub

---------------------------------------- fin de la macro

Mots clés Technorati : PowerPoint,VBA,Macro,Lien hypertexre