VBA Zone de texte dans en tête

Bonjour à tous,

Je dois créer une macro qui remplace une chaine de caractère par une autre.
Le problème est que la macro ne teste pas les zones de texte dans mon header ni mon footer (tout du moins sur Office XP/2007, sur office 2010 sa marche très bien).

Comment puis-je faire en sorte que ma macro teste les zones de texte du header et footer?
(peut-être un "For each frame..." ou quelque chose comme sa)

merci de vos réponse

7 réponses

  1. Modérateur
    Bonjour,
    Effectivement les zones de texte sont bien des "Shapes" (cochonnerie de shapes!!! ;-))
    Pour boucler sur tes shapes :
    Dim Obj As Shape
    For Each Obj In ActiveSheet.Shapes
        If Obj.Type = msoTextBox Then
            MsgBox "En v'la une!!!"
        End If
    Next Obj

    Si tu veux en connaitre davantage sur la gestion de ces sales bêtes : Voici un très bon tuto très complet
    3
    1. Bonjour,
      Aurais-tu un peu plus de précisions stp ? Dans un userform? Pour des objets sur une feuille?
      0
      1. merkiiiiiii,

        bon je teste sa et je reviens vers vous.
        pour répondre à Morgothal,
        je suis sur VBA d'excel et la macro doit traiter le texte de word.
        il s'agit d'arriver à modifier du texte situé dans une zone de texte dans le header et/ou footer du doc word (sa remplace bien partout sauf dans la zone de texte du header et footer).
        0
        1. re-bonjour,

          J'ai essayé et sa boucle bien sur tous les shapes (j'ai mis Obj as Variant et ActiveDocument pour Word).
          Mais comment agir sur le texte du shape (j'ai essayé text / Obj.TypeText Text:="y sans effet!!!).

          merci encore pour vos réponses.
          0
          1. Modérateur
            mmmmmm!! Toi tu veux du "tout-cuit"..... Tu n'as pas été consulter mon lien...
            Tu me feras trois pâtés et deux courgettes farcies en pénitence...
            Essaye quelque chose comme :
            Sub test()
            Dim Obj As Shape
            For Each Obj In ActiveSheet.Shapes
                If Obj.Type = msoTextBox Then
                    Obj.Select
                    With Selection
                        .Characters.Text = "ICI VIENDRA" & Chr(10) & "S'INSCRIRE VOTRE MESSAGE"
                    End With
                End If
            Next Obj
            End Sub
            0
        2. oui Msieur,
          ma pénitence sera hardue...

          merci pour tout...
          bon sa marche pas encore tout a fait correctement mais je bidouille pour essayer que cela marche.
          je reviens vite !
          0
          1. Modérateur
            N'hésite pas à poser toutes tes questions...
            Par exemple, si tu as, dans ta zone, comme texte : "ICI VIENDRA S'INSCRIRE VOTRE MESSAGE" et que tu souhaites remplacer "MESSAGE" par "TEXTE" tu peux utiliser la méthode Replace en passant par une variable de type string, comme ceci:
            Sub test() 
            Dim Obj As Shape 
            Dim Contenu As String 
            For Each Obj In ActiveSheet.Shapes 
                If Obj.Type = msoTextBox Then 
                    Obj.Select 
                    With Selection 
                        Contenu = Replace(.Characters.Text, "MESSAGE", "TEXTE") 
                        .Characters.Text = Contenu 
                    End With 
                End If 
            Next Obj 
            End Sub

            Syntaxe :
            Replace(dans quoi, mot à remplacer, mot de remplacement)
            0
        3. ok merci,
          j'ai déjà fait la fonction Replace.

          Le grooooooos problème c'est que ma zone de texte (situé dans le header d'un word n'est pas reconnue !!!!!). c'est fou sa !

          j'essaie d'activer les header/footer et de compter le nombre de shape et c'est égal à 0 !!! (alors qu'il y en a bien !!)

          la macro ci dessous

          Dim DocWord As New Word.Application
          Dim monTexte As Variant
          Dim Obj As Shape
          Dim TexteShapeAmodifier As String

          DocWord.Documents.Open NomFichier & "/" & Repertoire
          DocWord.Visible = True
          DocWord.Activate

          Word.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

          MsgBox Word.ActiveWindow.Document.Sections(1).Headers(wdHeaderFooterPrimary).Shapes.Count

          For Each Obj In Word.ActiveDocument.Sections(1).Headers(1).Shapes

          If Obj.Type = msoTextBox Then
          TexteShapeAmodifier = Obj.TextFrame.TextRange.Text
          TexteShapeAmodifier = Replace(TexteShapeAmodifier, "MTB111", "MTB")
          TexteShapeAmodifier = Replace(TexteShapeAmodifier, "MTB 111", "MTB")
          Obj.TextFrame.TextRange.Text = TexteShapeAmodifier
          End If
          Next Obj
          0
          1. Modérateur
            Peut être que ta zone de texte est un "Canvas"...
            Voir la méthode AddCanvas sur le site de Microsoft
            Je ne suis pas un spécialiste VBA Word et donc je ne sais pas te répondre correctement.
            Cependant, s'il s'agit d'un Canvas, la réponse se trouve dans le .Anchor (texte du canvas).
            Bonne suite
            0
        4. yipeeeeeeeeee enfin !!!! sa compte mes zone de texte.
          mais j'ai encore un ptit soucis (t'arrive à faire quelque chose et tu te redns compte que ce n'ets toujours pas fini).

          j'ai deux zone de texte qui sont groupées et donc il n'en compte qu'une et ne modifie pas.
          comment faire pour dissocier dans le header ?

          je mets la macro ci-dessous si cela peut servir à quelqu'un

          Dim DocWord As New Word.Application
          Dim monTexte As Variant
          Dim Obj As Word.Shape
          Dim TexteShapeAmodifier As String

          DocWord.Documents.Open NomFichier & "/" & Repertoire
          DocWord.Visible = True
          DocWord.Activate

          Word.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader

          'pour contrôler le nombre de zone du header
          'MsgBox Word.ActiveWindow.Document.Sections(1).Headers(1).Shapes.Count

          For Each Obj In Word.ActiveWindow.Document.Sections(1).Headers(1).Shapes
          If Obj.Type = msoTextBox Then
          TexteShapeAmodifier = Obj.TextFrame.TextRange.Text
          TexteShapeAmodifier = Replace(TexteShapeAmodifier, "MTB111", "MTB")
          TexteShapeAmodifier = Replace(TexteShapeAmodifier, "MTB 111", "MTB")
          End If
          Next Obj

          en tout cas merci à vous (et surtout à pijaku qui a assuré).
          0