copy/paste header de Word

Bon, j'ai pas trouvé encore de solution pour mon header. Mais je devais changer unique du texte, je suis passer par find et remplace.
Voici le code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Public Sub findReplaceHeader(pathdoc As String)
 
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim myRange As Range
 
    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Open(pathdoc)
 
    WordApp.Visible = False
 
    Set myRange = WordDoc.StoryRanges(wdPrimaryHeaderStory)
 
    With myRange.Find
        .Execute FindText:="TextRechercher", ReplaceWith:="TextRemplacer", Format:=True
    End With
 
    WordDoc.Save
    WordDoc.Close
 
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub

Et pour mon problème de footer, je devais garder le texte et ajouter un logo, là, j'ai trouvé la solution ;-)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Public Sub updateFooter(pathdoc As String)
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
 
    Dim myShape As Shape
    Dim PicRange As Range
 
    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Open("template.doc")
 
    WordApp.Visible = True
 
    Set myShape = WordDoc.Sections(1).Footers(wdHeaderFooterPrimary).Shapes.AddPicture(FileName:="2\logo_iag.png")
 
    With myShape
        .Left = -20
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
        .Top = -5
        .RelativeVerticalPosition = wdRelativeVerticalPositionPage
        .Width = 80
    End With
 
    WordDoc.Save
    WordDoc.Close
 
    WordApp.Quit
 
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub

Je mets résolu même si j'aurais aimer connaitre une solution pour un copy/past d'un header en gardant la mise en page ;)