Bonjour la compagnie

Depuis Excel, j'essaie de créer un Word avec un titre, suivi d'un tableau, suivi d'un autre titre et enfin son tableau correspondant...
J'arrive soit à écrire des titres, soit à remplir un tableau.
Avec ma macro, à chaque fois que j'écris, j'écris par dessus le titre ou le tableau précédent.
Comment les enchainer sans supprimer ce que j'ai ajouté précédemment?
Voici ma macro avec mes différentes tentatives de mise en page. (je verrai pour la raccourcir quand j'aurais un code qui fonctionne pour un tableau)

Je ne sais pas si le secret se trouve dans une possibilité de déplacer la sélection à la ligne (je ne sais pas comment)?? WordObj.Selection.àLaLigne ??
Ou si tout mon problème réside dans 'objDoc.Tables.Add' à complètement revoir??
Des idées? des suggestions?

Sinon ma sauvegarde permet d'enregistrer sur des SharePoint, j'en suis très contente n'hésitez pas à la récupérer!


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
102
103
104
105
Sub word(titre1 As String, titre2 As String, tableau1() As Variant, tableau2 As Variant, NomWord As String) 'cration du fichier Word
Dim h As Integer
 
Dim intNoOfRows As Integer, intNoOfColumns As Integer
Dim objRange
Dim objTable
Dim objDoc
 
intNoOfRows = 50
intNoOfColumns = 3
h = 0
 
Dim WordObj As Object
On Error Resume Next
Set WordObj = CreateObject("Word.Application")
Set objDoc = WordObj.Documents.Add
Set objRange = objDoc.Range
'Pour afficher Word
WordObj.Visible = False
 
With WordObj.Selection
   ' .Style = ActiveDocument.Styles("Titre")
    .Font.Size = 22
    .Font.Bold = True
    .TypeText text:=titre1
  ' .Styles ("Sans interligne")
    .Font.Size = 12
    .Font.Bold = False
    .TypeParagraph
End With
 
WordObj.Selection.TypeText text:=titre1
 
'Réussir à insérer ce tableau après la sélection, sans supprimer le titre au dessus
objDoc.Tables.Add objRange, intNoOfRows, intNoOfColumns, DefaultTableBehavior:=wdWord9TableBehavior, _
                    AutoFitBehavior:=wdAutoFitFixed
 
Set objTable = objDoc.Tables(1)
 
objTable.cell(2, 1).Range.text = "Donnée d'entrée"
objTable.cell(2, 2).Range.text = "spécifique"
objTable.cell(2, 3).Range.text = "Indice de prise en compte"
 
Do While tableau1(h) <> Empty
        objTable.cell(2, 1).Range.text = tableau1(h)
        objTable.cell(2, 1).Range.TypeParagraph
        h = h + 1
        Loop
        h = 0
 
With WordObj
    .Selection.TypeText text:=titre2
    .Selection.Font.Size = 16
    .Selection.TypeParagraph
    .Selection.Font.Size = 14
    .Selection.TypeText text:="second titre oui oui"
    .Selection.TypeParagraph
    .Selection.Font.Size = 8
    .ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=intNoOfRows, NumColumns:= _
        intNoOfColumns, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
        wdAutoFitFixed
End With
 
 
    Set objTable = objDoc.Tables(2)
 
'With WordObj.Selection
'    .Font.Size = 18
'    .Font.Bold = True
'    .TypeText text:=titre2
'End With
 
objTable.cell(2, 1).Range.text = "Donnée d'entrée"
objTable.cell(2, 2).Range.text = "spécifique"
objTable.cell(2, 3).Range.text = "Indice de prise en compte"
 
 
Do While tableau2(h) <> Empty
    Set objTable = objDoc.Tables.Add(Range:=Selection.Range, NumRows:=intNoOfRows, NumColumns:=intNoOfColumns)
    Dim cmpt As Long
 
    For cmpt = 3 To objTable.Rows.Count
        objTable.cell(cmpt, 1).Range.Font.Size = 8
        objTable.cell(cmpt, 1).Range.text = tableau2(h)
        h = h + 1
    Next cmpt
    Loop
    h = 0
 
 
'sauvegarde ce Word avec le nom de la chaine de caractère appellée NomWord dans le chemin de sauvegarde myPath
myPath = ActiveWorkbook.Path & Application.PathSeparator
 
With WordObj.ActiveDocument
    .SaveAs Filename:=myPath & NomWord, FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
 
End With
 
WordObj.Application.Quit
 
End Sub

Force et robustesse!