Copier/coller ligne de tableaux Word dans un autre doc Word

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:

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.

Citation:

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 ?

Comme c'est une question de copier/coller, on regarde évidemment les lignes spécifiques de .Copy et .Paste ou du genre. Avez-vous essayé ceci ?
Code:

1 2 'objSelectionDest.Paste objSelectionDest.PasteAndFormat 16 'wdFormatOriginalFormatting=16

Cela fonctionne parfaitement, merci bcp pour ton aide :) :applo:

Et comment puis-je mettre en gras les cellules copiées dans le document word destinataire ?

Essaie avec objSelectionDest.BoldRun qui devrait inverser la mise en forme(gras / normal)

Citation:

Et comment puis-je mettre en gras les cellules copiées dans le document word destinataire ?

Je ne peux que projeter un peu puisque je ne sais pas les détails de ces documents.

Dans le document destiné, le "cursor" semble se positionner à la fin avant de paste. Par conséquence, le tableaux serait de l'indice le plus grand. En fait, la collection de tableaux est dynamique, mise à jour tout le temps. On peut donc l'identifier par le moyen comme ça, en gros.

Code:

set otbl=documentObjWordDest.tables(documentObjWordDest.tables.count)

Avec cette réference du tableau en question, on peut donc construire un rang, soit une ligne, soit une colonne, soit une cellule comme on veut. Pour une cellule, ça peut paraître comme

Code:

set rng=otbl.cell(i,j).range

et pour une colonne ou une partie d'elle, ça peut paraître comme

Code:

set rng=documentObjWordDest.range(otbl.cell(i,j).range.start, otbl.cell(k,j).range.end)

etc...

Après le rang étant établi, ça devient très simple et on fait comme ça.
Code:

1 2 rng.select rng.font.bold=true
Et ça serait fait. En gors, comme ça. Je peux me tromper le détail puisque c'est un exercice purement mental ici.