Affichage des articles dont le libellé est Macro. Afficher tous les articles
Affichage des articles dont le libellé est Macro. Afficher tous les articles

dimanche 11 janvier 2015

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

bt-powerpoint 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 : ,,,

jeudi 7 août 2014

PowerPoint : une macro pour redéfinir la langue de vérification de tous les zones de texte d’une présentation

Powerpoint-2013 Ce billet fait suite à un problème soulevé sur le forum Answers de Microsoft.

La question posée portait sur la possibilité de redéfinir (ou changer) en une seule fois la langue de vérification dans toutes les diapositives et la solution proposée présentait certains bugs (ou manques). En effet, la langue n’était pas redéfinie dans les cas suivants :

  1. L’espace réservé pour le contenu ne contient pas encore de texte.
  2. La zone de texte a été ajouter manuellement à la diapositive.

Pour contourner cela, je vous propose la macro ci-dessous:

------------------------------------------

Public Sub ChangerLangueVérification()
    '
    ' Macro proposée par Mehdi HAMMADI le 07/08/2014
    '
    ' Objectif : changer la langue de vérification de tous les espaces réservés
    '            et de toutes les zones de texte de la présentation en cours
    Dim DiapoEnCours As Slide
    Dim FormeEnCours As Shape
    For Each DiapoEnCours In ActivePresentation.Slides
        For Each FormeEnCours In DiapoEnCours.Shapes
            FormeEnCours.TextFrame.TextRange.LanguageID = msoLanguageIDFrench
        Next
    Next
End Sub

------------------------------------------

Le principe est simple, parcourir toutes les zone de texte de tous les formes et appliquer la langue souhaitée.

  • Pour le français mettre .LanguageID = msoLanguageIDFrench
  • Pour l’anglais états unis mettre .LanguageID = msoLanguageIDEnglishUS

Testé sous PowerPoint 2013 et 2007

Mots clés Technorati : ,,,,

mardi 26 mars 2013

VBA Word : macro pour supprimer tous les champs de type AUTOTEXTLIST

Bonjour à tous,

OFFICE_WORD_2010il y a quelques jours un internaute “Manu” m’interpelez sur ce blog après la lecture d’un article intitulé “Afficher une info-bulle contenant la définition d’un mot au survol de la souris en utilisant le champ AUTOTEXTLIST” et me demandait de lui fournir une macro qui lui permettrait d’automatiser l’insertion d’une info-bulle pour toutes les occurrences d’un même mot. Après quelques heures de travail, je fus en mesure de lui apporter une réponse que je publiais sur l’article suivant “Ajouter une info bulle à toutes les occurrences d’un mot dans un document Word”.

Après test et utilisation de la macro par Manu, celui-ci est revenu vers moi avec des commentaires qui m’ont permis de corriger certains bugs. Manu demandas également deux autres macros, l’une permettant de supprimer toutes les info-bulles et la seconde permettant de supprimer les info-bulles d’une occurrence précise.

Je propose donc ci-après une macro permettant de supprimer tous les champs de type AUTOTEXTLIST

----------------------------------------------------------------------------------------------

Sub SupprimerToutesLesInfobulles()

’ Macro SupprimerToutesLesInfobulles, créée par Mehdi HAMMADI le 26/03/2013
’ suite à la requête d’un internaute sur le blog Office Users
’ Objectif : supprimer tous les champs de type AUTOTEXTLIST

    Dim nbChamps As Integer
   
    nbChamps = ActiveDocument.Fields.Count
   
    For i = nbChamps To 1 Step -1
       
        If Left(ActiveDocument.Fields(i).Code, 13) = " AUTOTEXTLIST" Then
            ActiveDocument.Fields(i).Select
            Selection.Text = ActiveDocument.Fields(i).Result
        End If
   
    Next
   
    Selection.HomeKey Unit:=wdStory

End Sub

----------------------------------------------------------------------------------------------

Mots clés Technorati : ,,,,

vendredi 15 mars 2013

Ajouter une info bulle à toutes les occurrences d’un mot dans un document Word

Il y a quelques temps je publiais un article intitulé “Word : afficher une info-bulle contenant la définition d’un mot au survol de la souris en utilisant le champ AUTOTEXTLIST” dans cette article j’explique comment ajouter dans Word une info-bulle à un mot permettant de l’expliquer ou de le définir. Suite à cette article un Internaute m’a demandé de lui fournir une macro qui permettrait d’automatiser cette tâche.

Je vous présente donc “InfoBulle” une macro qui recherche l’occurrence d’un mot dans un document puis le remplace par un champ permettant d’afficher lorsque vous survolez le mot avec la souris une info-bulle qui contient un texte pouvant être utilisé pour définir ou expliquer le mot survolé. Cette macro a été fait sous Word version 2010.

La macro ‘Infobulle’

Sub InfoBulle()
'
' Macro Info-bulle, créée par Mehdi HAMMADI le 15/03/2012
' Suite à la requête d'un Internaute sur le site Office Users
' Objectif rechercher les différentes occurrences d'un mot dans un texte puis lui ajouter une infobulle.
' Merci à Circé pour la partie de code permettant de compté le nombre d'occurence d'un mot
’ (http://www.faqword.com/index.php/word/faq-word/vba-solutions/555-comment-compter-le-nombre-doccurences-contenues-dans-un-document)
   
    Dim strMotARecherche As String
    Dim strTexteInfoBulle As String
    Dim strTexteDuChamp As String
   
    strMotARechercher = InputBox("Saisissez le mot", "Mot à rechercher")
    strTexteInfoBulle = InputBox("Saisissez le texte de l'info-bulle", "Info-bulle")
   
    If IsNull(strMotARechercher) Or strMotARechercher = "" Or IsNull(strTexteInfoBulle) _
        Or strTexteInfoBulle = "" Then
        Exit Sub
    Else
        Selection.HomeKey Unit:=wdStory
        strTexteDuChamp = "AUTOTEXTLIST " & chr$(34) & strMotARechercher & chr$(34) & " \t " _
        & chr$(34) & strTexteInfoBulle & chr$(34)
        iCount = 0
        With ActiveDocument.Content.Find
            Do While .Execute(FindText:=strMotARechercher, Format:=False, _
                MatchCase:=False, MatchWholeWord:=True) = True
                iCount = iCount + 1
            Loop
        End With
       
        If iCount = 0 Then
            MsgBox ("pas de correspondance")
            Exit Sub
        End If
              
        Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .Text = strMotARechercher
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = True
        End With
       
        For i = 1 To iCount
            Selection.Find.Execute
            ActiveWindow.View.ShowFieldCodes = True
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
            Text:=strTexteDuChamp, PreserveFormatting:=True
            ActiveWindow.View.ShowFieldCodes = False
        Next
    End If
End Sub

Mots clés Technorati : ,,,