Discussion :

[lepotier]

Bonjour à tous,

Voilà, je dois modifier le header et footer de +ou- 700 documents.

Je réussi à faire le copier (d'un modèle) et le coller sur mes documents mais le problème c'est que la mise en page est modifié, j'ai bien les images, les couleurs du texte, juste l'alignement du texte n'est pas "coller"

Voici mon code pour le header:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Public Sub updateHeader(pathDoc As String)
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim WordTemplate As Word.Document
 
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(pathDoc)
Set WordTemplate = WordApp.Documents.Open("templateHeaderSpeed.doc")
WordApp.Visible = True
WordDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete 'J'ai rajouté cette ligne en pensant que si je supprimait l'ancien header, cela marcherai ;)
 
WordTemplate.Sections(1).Headers(wdHeaderFooterPrimary).Range.Copy
WordDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Paste
 
End Sub

Quelqu'un aurais une idée ?

Et ma deuxième question: je dois aussi modifier le footer, la différence est que je dois concerver le texte et ajouter un logo.

Une piste ?

Merci,

[lepotier]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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