Discussion :

[funkyf]

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!

[Invité]

Bonjour,

Une fois le titre mis en place, il faut se déplacer en fin de document avec la méthode EndKey et créer la table à partir de cette nouvelle sélection.

J'ai simulé la mise en place d'un titre et d'une table dans un document Word (donc à adapter depuis Excel). Notez que la mise en place de la table se fait avec ObjSelection.Range.

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
 
Sub InsererUnTitreEtUneTable()
 
Dim WordObj As Application, ObjDoc As Document, ObjSelection As Selection
Dim intNoOfRows As Integer, intNoOfColumns As Integer, h As Integer
 
    intNoOfRows = 50
    intNoOfColumns = 3
 
    Set WordObj = Application
    Set ObjDoc = WordObj.Documents.Add
    Set ObjSelection = WordObj.Selection
 
    With ObjDoc
 
         ObjSelection.TypeText Text:="titre1"
         ObjSelection.EndKey unit:=wdStory   ' Pour lui dire d'aller à la fin du document
         .Tables.Add ObjSelection.Range, intNoOfRows, intNoOfColumns
 
    End With
 
    Set WordObj = Nothing
    Set ObjSelection = Nothing
    Set ObjDoc = Nothing
 
 
End Sub

Nb : Il vaudrait mieux changer le nom de votre procédure : Word étant un mot réservé.