Bonjour,

je cherche à :
  • mettre un bandeau avec MOIS + ANNEE centré, en corps gras et encadré dans un document cible,
  • mettre en dessous la date du jour aligné à gauche sans le corps gras,
  • enfin, copier/coller certaines lignes d'un document Word source dans un autre document Word cible en conservant les styles.


De plus, dans certains cas, je voudrais également en collant, mettre la ligne en gras...

Voici un bout de code qui arrive à peu près à faire les actions ci-dessus mais les différentes lignes ne gardent leurs aspects originales :

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
 
Const wdStory = 6
Const wdMove = 0
Const wdBorderLeft = -2, _
      wdBorderRight = -4, _
      wdBorderTop = -1, _
      wdBorderBottom = -3, _
 
Dim objWordSource, documentObjWordSource
Dim objWordDest, documentObjWordDest, objSelectionDest
Set objWordSource = CreateObject("Word.Application") 
Set objWordDest = CreateObject("Word.Application") 
 
' don't display any messages about documents needing to be converted from old Word file formats
objWordSource.DisplayAlerts = 0
objWordDest.DisplayAlerts = 0
 
' open the Word document as read-only ; open (path, confirmconversions, readonly)
objWordSource.Documents.Open <sourceFile>, false, true
objWordDest.Documents.Open <destFile>, false, false
 
Set documentObjWordSource = objWordSource.Documents(1)
Set documentObjWordDest = objWordDest.Documents(1)
 
Dim bandeauMoisAnnee, dateCompleteDuJour
bandeauMoisAnnee = "NOVEMBRE 2014"
dateCompleteDuJour = "mercredi 19 novembre 2014"
 
' Positionnement du bandeau
Set objSelectionDest = objWordDest.Selection
objSelectionDest.EndKey wdStory, wdMove
objSelectionDest.TypeParagraph()
objSelectionDest.TypeParagraph()
objSelectionDest.Font.Size = "11"
objSelectionDest.Font.Name = "Times New Roman"
objSelectionDest.Font.Bold = True
objSelectionDest.ParagraphFormat.Alignment = 1 'centre
objSelectionDest.Borders.Enable = True
objSelectionDest.TypeText bandeauMoisAnnee
objSelectionDest.TypeParagraph()
 
objSelectionDest.ClearFormatting
objSelectionDest.ParagraphFormat.Alignment = 0 'gauche
objSelectionDest.Borders(wdBorderBottom).Visible = False
objSelectionDest.Borders(wdBorderLeft).Visible = False
objSelectionDest.Borders(wdBorderRight).Visible = False
objSelectionDest.Borders(wdBorderTop).Visible = False
 
Set objSelectionDest = Nothing
 
' on insère la date du jour
Set objSelectionDest = objWordDest.Selection
objSelectionDest.EndKey wdStory, wdMove
objSelectionDest.TypeParagraph()
objSelectionDest.TypeText dateCompleteDuJour
objSelectionDest.TypeParagraph()
Set objSelectionDest = Nothing
 
Dim table, ligne
Dim dateSign, typeEtabSign, nomEtabSign, communeSign
 
For Each table In documentObjWordSource.Tables
    For ligne = 1 To table.Rows.Count
            dateSign = table.Cell(ligne, 1).Range.Text
            typeEtabSign = table.Cell(ligne, 2).Range.Text
            nomEtabSign = table.Cell(ligne, 3).Range.Text
            communeSign = table.Cell(ligne, 4).Range.Text
 
            If dateSign <> "" And Instr(LCase(dateSign), "date") = 0 Then
 
                    Set objSelectionDest = objWordDest.Selection
                    If ((ligne Mod 2) > 0) Then
                        ' Cas d'une nouvelle rubrique
                        objSelectionDest.EndKey wdStory, wdMove
                        objSelectionDest.TypeParagraph()
                        objSelectionDest.TypeParagraph()
                        objSelectionDest.TypeText "Groupement " & ligne & " : "
                        objSelectionDest.TypeParagraph()
                    End If
 
                    documentObjWordSource.Range(table.Cell(ligne, 1).Range.Start, table.Cell(ligne, 4).Range.End).Select.Copy
                    objSelectionDest.Paste
 
                    Set objSelectionDest = Nothing
            End If
        End If
    Next
Next
 
' Close the document
documentObjWordSource.Close
documentObjWordDest.Close
 
' Free memory used to store the document object
Set documentObjWordSource = Nothing
Set documentObjWordDest = Nothing
 
objWordSource.Quit
Set objWordSource = Nothing
objWordDest.Quit
Set objWordDest = Nothing
Qu'est-ce qu'il ne va pas dans mon code pour que je ne puisse pas coller les lignes de mon tableau avec les styles pour avoir le même rendu que dans le document initial ?
Comment puis-je faire pour mettre en gras la ligne au moment de la coller dans le document word destinataire (lignes 80 et 81 du code) ?

Merci beaucoup pour votre aide,
F.