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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
| Sub MettreAJourLesSignets()
Dim WordApp As Word.Application
Dim DocEnCours As Word.Document
Dim MaSelection As Word.Selection
Dim MaForme As Word.Shape
Dim TableParametres2 As ListObject
Dim InfosFichiers As Range
Dim CheminCompletWord As String
Dim FichierEnCours As Workbook
Dim NomAvant As String
Dim NomApres As String
Dim i As Long
'On Error GoTo Fin
With Sheets("Liste des tableaux")
CheminCompletWord = .Range("WordRepertoire") & "\" & .Range("WordFichier")
'CheminCompletWord = C:\Users\gx5932\Documents\Modèles Office personnalisés\Test.dotm
Set TableParametres2 = .ListObjects("TableDesParametres")
'TableParametres2 = "TableDesParamètres"
Set InfosFichiers = TableParametres2.ListColumns("Nom du fichier").DataBodyRange
'Crée un tableau contenant les données du tableau renseigné en réel (ici, de A11 à G?)
End With
Set WordApp = CreateObject("word.application") 'ouvre session word
With WordApp
.Visible = True
.ChangeFileOpenDirectory Sheets("Liste des tableaux").Range("WordRepertoire")
'Définit C:\Users\gx5932\Documents\Modèles Office personnalisés comme le dossier dans lequel Word recherche les documents
Set DocEnCours = .Documents.Add(CheminCompletWord)
'DocEnCours = C:\Users\gx5932\Documents\Modèles Office personnalisés\Test.dotm
Set MaSelection = WordApp.Selection
End With
For i = 1 To InfosFichiers.Count
'Pour chaque ligne du tableau, c'est-à-dire chaque fichier à importer
If InfosFichiers(i).Offset(0, 2) <> "" Then
'Si l'onglet correspondant n'est pas vide (ex : "2019", "LISTE",...)
OuvertureFichiers InfosFichiers(i), InfosFichiers(i).Offset(0, 1)
'Ouvre le fichier en question
Set FichierEnCours = ActiveWorkbook
If InfosFichiers(i).Offset(0, 3) = "" Then
'Si pas d'aire demandée
RechercheAireAcopier FichierEnCours, InfosFichiers(i).Offset(0, 2)
'AireACopier = vraie aire à copier (calculée)
Else
RechercheAireAcopier FichierEnCours, InfosFichiers(i).Offset(0, 2), InfosFichiers(i).Offset(0, 3)
'AireACopier = vraie aire à copier (demandée)
End If
AireACopier.Copy
With MaSelection
.GoTo What:=wdGoToBookmark, Name:=InfosFichiers(i).Offset(0, 4)
'Se place au niveau du marque-page correspondant
.MoveDown unit:=wdParagraph, Count:=1, Extend:=wdExtend
'Déplace vers le bas d'un paragraphe et renvoie la distance de déplacement sous la forme d’un nombre d’unités
.PasteSpecial Link:=True, DataType:=4, Placement:=wdInLine
'On le colle dans le doc atuel (word), avec lien avec le tableau sous Excel, sous format image
End With
With DocEnCours
If .InlineShapes.Count > 0 Then
'Si le nombre d'éléments dans la collection spécifiée est non nul
Set MaForme = .InlineShapes(1).ConvertToShape
With MaForme
'.ConvertToInLineShape
NomAvant = .Name
.Name = InfosFichiers(i).Offset(0, 4)
NomApres = .Name
Debug.Print "Nom avant : " & NomAvant & ", nom après : " & NomApres
Select Case .Name
'.Name est la valeur à vérifier
Case "Tableau_1", "Tableau_2", "Tableau_3", "Tableau_4"
'Si la condition "Tableau_1" ou "Tableau_2" ou "Tableau_3" ou "Tableau_4" est remplie
MettreEnFormeUneFormeShape MaForme, InfosFichiers(i).Offset(0, 5), InfosFichiers(i).Offset(0, 6)
End Select
End With
End If
End With
FermetureFichiers FichierEnCours.Name, False
Set FichierEnCours = Nothing
End If
Next i
With DocEnCours
' For I = 1 To .Shapes.Count
' Debug.Print .Shapes(I).Name
' Next I
.Close savechanges:=wdSaveChanges 'si on veut fermer le document word en sauvegardant les données
End With
GoTo Fin
Fin:
WordApp.Quit
'ferme la session Word
Set InfosFichiers = Nothing
Set TableParametres2 = Nothing
Set MaSelection = Nothing
Set DocEnCours = Nothing
Set WordApp = Nothing
End Sub |
Envoyé par Wilkoo
Répondre avec citation
Partager