Discussion :

[Wilkoo]

Pour le mois de mai, le nom de l'onglet est Feuil1.

Nb : Si le nom de l'onglet est un nom de mois, regardez la syntaxe pour le nom de l'onglet pour le mois de juin.
Pièce jointe 488274
J'ai du mettre l'apostrophe avant le nom de l'onglet pour qu'Excel considère la chaîne comme alphanumérique.

Ca fonctionne parfaitement ! Merci beaucoup !

Du coup pour en revenir au sujet de base, si maintenant je veux changer les dimensions de chaque objet individuellement, je crée une colonne où je mets les dimensions souhaitées et je modifie la macro pour rajouter cette modification ?
Ou il y a plus simple à faire ?

[Invité]

Ou il y a plus simple à faire ?

Sans doute, mais je ne connais pas.

Du coup pour en revenir au sujet de base, si maintenant je veux changer les dimensions de chaque objet individuellement, je crée une colonne où je mets les dimensions souhaitées et je modifie la macro pour rajouter cette modification ?

Si vous avez compris le fonctionnement des procédures paramétriques, il vous suffit d'ajouter vos paramètres dans la procédure MettreEnFormeUneFormeShape actuellement non utilisée :

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
 
 
Sub MettreEnFormeUneFormeShape(ByVal ShapeEnCours2 As Word.Shape)
 
         With ShapeEnCours2
 
               'On redimensionne l'image
               .ScaleWidth 0.49, msoFalse, msoScaleFromTopLeft
               .ScaleHeight 0.49, msoFalse, msoScaleFromBottomRight
               'On déplace l'image
               .IncrementLeft 44.25
               .IncrementTop -8.25
 
               'On fait en sorte que le texte se positionne autour de l'image, et non pas dessous (par défaut)
               With .WrapFormat
                    .AllowOverlap = True
                    .Side = wdWrapBoth
                    .DistanceTop = CentimetersToPoints(0)
                    .DistanceBottom = CentimetersToPoints(0)
                    .DistanceLeft = CentimetersToPoints(0.32)
                    .DistanceRight = CentimetersToPoints(0.32)
                    .Type = wdWrapSquare
               End With
          End With
 
End Sub

[Wilkoo]

Sans doute, mais je ne connais pas.




Si vous avez compris le fonctionnement des procédures paramétriques, il vous suffit d'ajouter vos paramètres dans la procédure MettreEnFormeUneFormeShape actuellement non utilisée

Je m'y attelle !

Je vous remercie du fond du cœur pour votre aide.

[Invité]

Je m'y attelle !

Au cas où vous passeriez trop de temps sur le formatage d'un document Word qui au final "devrait" être lu seulement en pdf, le plan B est de faire la même chose directement sur un fichier modèle Excel. Le code VBA est de mon point de vue plus simple et vous pouvez aligner vos shapes sur les cellules.

[Wilkoo]

Au cas où vous passeriez trop de temps sur le formatage d'un document Word qui au final "devrait" être lu seulement en pdf, le plan B est de faire la même chose directement sur un fichier modèle Excel. Le code VBA est de mon point de vue plus simple et vous pouvez aligner vos shapes sur les cellules.

J'ai du mal à me rendre compte de ce que ça pourrait donner ? Est ce qu'il s'agirait de faire toute la mise en page sur un doc Excel, ensuite exporté sous PDF ?
Pourrai-je obtenir le même rendu (mise en forme, photos, sommaire) que le rapport de plusieurs pages sous format papier que je dois produire ?

Merci d'avance de votre réponse

[Wilkoo]

A adapter et à tester. Le code est lancé depuis le fichier Excel. WordDoc est un .dotm. Je n'ai pas traité la partie graphique.

J'ai aussi rencontré quelques problèmes lors de l'utilisation de ce code sur mes fichiers réels, plus complexes que de simples tableaux (cases contenant des graphiques, plusieurs tableaux dans la même page). A chaque fois, j'ai essayé de sélectionner la plage qui m'intéressait, mais j'ai rencontré très souvent la même erreur : "Méthode ConvertToShape de InlineShape a échoué". Ce qui m'étonne est que cela arrive aussi sur des fichiers qui semblent ne poser aucun problème (tableau simple), et fonctionnent sur des fichiers du même type que certains qui ne fonctionnent pas.

Sauriez-vous comment régler ce problème je vous prie ?

[Invité]

N'ayant pas vos fichiers, je ne peux pas vous répondre. Servez-vous de Debug.print pour voir ce que vous récupérez. J'imagine que vous n'avez pas la main pour transformer vos tableaux 1, 2, etc en tableaux référencés (comme le ListObject qui sert à lancer les exports), dans le cas contraire, l'extraction des données est beaucoup plus simple.

[Invité]

J'ai du mal à me rendre compte de ce que ça pourrait donner ? Est ce qu'il s'agirait de faire toute la mise en page sur un doc Excel, ensuite exporté sous PDF ?
Pourrai-je obtenir le même rendu (mise en forme, photos, sommaire) que le rapport de plusieurs pages sous format papier que je dois produire ?

J'utilise cette méthode pour établir des statistiques mensuelles. Elle est valable si vous n'avez pas trop de commentaires à apporter et si les données à présenter sont toujours les mêmes. L'édition se fait en sélectionnant les onglets concernés. Ces onglets peuvent être présentés en portrait ou en paysage. Si vous transformez le fichier que je vous ai envoyé en .xltm, celui-ci peut servir de support à votre rapport.

Pour la mise en page, il vous suffit de la régler selon celle déjà présente dans l'onglet Liste des tableaux (paysage ou portrait), et d'insérer des sauts de page aux endroits nécessaires une fois déterminés les emplacements de vos articles et en ajustant quelques hauteurs de lignes pour que le résultat soit présentable.

Pièce jointe 488370

[Wilkoo]

D'accord, merci pour cette explication !

Cependant, je pense que je vais devoir le faire sur un document Word malgré tout, le rendu attendu doit être nickel et j'ai déjà un document word modèle, qui ne doit pas bouger, et où je dois simplement insérer les tableaux et images voulus aux endroits demandés.

Mais merci pour cette proposition, je ne manquerai pas d'y penser si la situation se présente à l'avenir !

[Wilkoo]

J'imagine que vous n'avez pas la main pour transformer vos tableaux 1, 2, etc en tableaux référencés

En effet... dommage

N'ayant pas vos fichiers, je ne peux pas vous répondre. Servez-vous de Debug.print pour voir ce que vous récupérez.

Je vais faire ça dès que possible, je viens de revoir tout l'algorithme pour en comprendre le fonctionnement dans le détail !

La partie qui semble poser problème est justement celle que je ne comprends pas vraiment dans MettreAJourLesSignets(). Pourriez-vous m'expliquer exactement comment fonctionne cette partie je vous prie, pour que j'essaie de corriger ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
With DocEnCours
                If .InlineShapes.Count > 0 Then
                    .InlineShapes(1).ConvertToShape.ConvertToInlineShape
                End If
            End With

Merci !

[Invité]

Chaque partie collée depuis Excel est un objet InlineShape dans Word. Dès lors qu'on transforme tout de suite après collage cet objet en objet Shape avec la commande ConvertToShape, la logique veut qu'il n'y ait toujours au plus qu'un seul objet InLineShape présent dans le document. C'est pour cette raison qu'on récupère toujours l'indice 1 de la collection. Cependant, si vous récupérez plus d'un objet InlineShape en copiant, c'est certain que les mises à jour ne vont pas se faire correctement. Pour cela, vérifiez avec un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Debug.Print .InLineShapes.Count

ce que vous récupérez.

Sinon, pour ce qui est .ConvertToInlineShape, regardez ce qui se passe en ne conservant que .InlineShapes(1).ConvertToShape

[Wilkoo]

Bonjour ! Je viens de reprendre mon document !

Pour cela, vérifiez avec un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Debug.Print .InLineShapes.Count

ce que vous récupérez.

J'ai essayé, mais je n'obtiens rien en particulier, même en cliquant sur "débogage"... est-ce normal ?

Sinon, pour ce qui est .ConvertToInlineShape, regardez ce qui se passe en ne conservant que .InlineShapes(1).ConvertToShape

Effectivement, cela fonctionne pour l'insertion des documents, mais ils ne décalent plus le texte et ne se retrouvent plus forcément au bon endroit dans la feuille... c'est un peu le fouillis ? Je me suis dit qu'il fallait alors réorganiser tout ça en utilisant MettreEnFormeUneFormeShape, mais je n'arrive pas à bien le placer et j'obtiens des bugs quoi qu'il arrive, ou alors pas le résultat voulu. Et en n'utilisant plus "InLineShapes", difficile de mettre en forme un objet en particulier, puisqu'il existe d'autres shapes dans mon document...

[Invité]

Bonjour,

Pour les Debug.Print : Ctrl-G pour faire apparaître la fenêtre exécution.
Pour les shapes, il vous faut leur donner un nom à leur création pour pouvoir les manipuler facilement ensuite.

[Wilkoo]

J'ai essayé, mais je n'obtiens rien en particulier, même en cliquant sur "débogage"... est-ce normal ?

Au temps pour moi ! Je viens d'ouvrir la fenêtre d'éxécution, et tant que cela marche :
- le doc en question s'ouvre
- le doc en question se ferme
- dans la fenêtre d'exécution, un chiffre apparaît, augmentant de 1 à chaque fois (il y a bien un objet InLineShape en plus)

Ceci jusqu'au doc posant problème, où
- le doc s'ouvre
- le message d'erreur apparaît (Erreur : "La méthode 'ConvertToShape' de l'objet 'InlineShapes' a échoué")
- rien n'apparaît dans la fenêtre d'éxecution

Je ne sais pas trop quoi en conclure (si ce n'est qu'effectivement, l'objet n'est pas transformé en InLineShapes) ?

[Wilkoo]

Pour les shapes, il vous faut leur donner un nom à leur création pour pouvoir les manipuler facilement ensuite.

Je dois vraiment paraître pas très douée, mais j'ai commenccé très récemment vba et j'ai un peu de mal...
Comment s'y prendre pour leur donner un nom ? J'ai essayé un Selection.Name("toto"), mais ça n'a pas l'air de fonctionner... ("Propriété ou méthode non gérée par cet objet")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
With DocEnCours
                If .InlineShapes.Count > 0 Then
                'Si le nombre d'éléments dans la collection spécifiée est non nul
                    .InlineShapes(1).ConvertToShape
                    Selection.Name ("toto")
                    'MettreEnFormeUneFormeShape .Shapes("toto")

[Wilkoo]

J'ai fait des essais pour implémenter le code me permettant de redimensionner mes formes (je fais mes test avec celles qui fonctionnent avec .ConvertToInLineShapes seulement). Pour cela, j'ai ajouté 2 colonnes au tableau : une avec % Dimension Souhaitée (0.56 par exemple) et une avec Position Souhaitée
J'ai le code suivant :

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Option Explicit
 
 
' Référencer la DLL Microsoft Word
 
Public DimensionSouhaitee As String
Public PositionSouhaitee As String
Public AireACopier As Range
 
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 I As Long
 
Dim Sh As Shape
 
 
 
    '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
 
 
            If InfosFichiers(I).Offset(0, 5) = "" Then
            'Si pas de dimension demandée
                MettreEnFormeUneFormeShape Selection, InfosFichiers(I).Offset(0, 5), InfosFichiers(I).Offset(0, 6)
                'DimensionSouhaitee = 0.56 par exemple
                'PositionSouhaitee = 37 par exemple
            End If
 
            With MaSelection
            'On redimensionne l'image
            .ScaleWidth DimensionSouhaitee, msoFalse, msoScaleFromTopLeft
            .ScaleHeight DimensionSouhaitee, msoFalse, msoScaleFromBottomRight
            'On déplace l'image
            .IncrementLeft PositionSouhaite
            '.IncrementTop -8.25
 
 
            With DocEnCours
                If .InlineShapes.Count > 0 Then
                'Si le nombre d'éléments dans la collection spécifiée est non nul
                    .InlineShapes(1).ConvertToShape.ConvertToInlineShape
 
                    'MettreEnFormeUneFormeShape .Shapes("toto")
 
                End If
            End With
 
            FermetureFichiers FichierEnCours.Name, False
 
            Set FichierEnCours = Nothing
 
        End If
 
        Next I
 
        'For Each Sh In DocEnCours.Shapes
            'On Error Resume Next
            'Debug.Print Sh.Name, Sh.AlternativeText, Sh.Title, Sh.TextFrame.Characters.Text
        'Next Sh
 
 
        DocEnCours.Close savechanges:=wdSaveChanges
        'si on veut fermer le document word en sauvegardant les données
 
        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

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
Sub MettreEnFormeUneFormeShape(ByVal ShapeEnCours2 As Word.Shape, Optional DimensionSouhaitee2 As String, Optional PositionSouhaitee2 As String)
 
        With ShapeEnCours2
 
            If DimensionSouhaitee2 <> "" Then
            'S'il y a une dimension demandée
                Set DimensionSouhaitee = DimensionSouhaitee2
                'DimensionSouhaitee = 0.56 par exemple
            End If
 
            If PositionSouhaitee2 <> "" Then
            'S'il y a une dimension demandée
                Set PositionSouhaitee = PositionSouhaitee2
                'PositionSouhaitee = 37 par exemple
            End If
 
            'On fait en sorte que le texte se positionne autour de l'image, et non pas dessous (par défaut)
            With .WrapFormat
                .AllowOverlap = True
                .Side = wdWrapBoth
                .DistanceTop = CentimetersToPoints(0)
                .DistanceBottom = CentimetersToPoints(0)
                .DistanceLeft = CentimetersToPoints(0.32)
                .DistanceRight = CentimetersToPoints(0.32)
                .Type = wdWrapSquare
            End With
        End With
 
End Sub

Je pense que ce qui me manque est cette partie :

Pour les shapes, il vous faut leur donner un nom à leur création pour pouvoir les manipuler facilement ensuite.

En effet, ma Selection ne semble pas être de type Shape (requis par MettreEnFormeUneFormeShape pour fonctionner)

Qu'en pensez-vous ?

[Invité]

Sur quel fichier avez vous un problème ? Que cherchez-vous à récupérer ?

J'ai modifié le code pour vous montrer comment on peut modifier le nom d'un objet shape. Pour mettre en forme l'objet Shape, il faut intervenir dès que MaForme est instanciée.

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
106
107
 
Public AireACopier As Range
 
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 AireFichiers As Range
Dim CheminCompletWord As String, NomAvant As String, NomApres As String
Dim FichierEnCours As Workbook
 
Dim I As Long
 
 
 
    On Error GoTo Fin
 
 
    With Sheets("Liste des tableaux")
         CheminCompletWord = .Range("WordRepertoire") & "\" & .Range("WordFichier")
         Set TableParametres2 = .ListObjects("TableDesParametres")
         Set AireFichiers = TableParametres2.ListColumns("Nom du fichier").DataBodyRange
    End With
 
    Set WordApp = CreateObject("word.application") 'ouvre session word
 
    With WordApp
         .Visible = True
         .ChangeFileOpenDirectory Sheets("Liste des tableaux").Range("WordRepertoire")
         Set DocEnCours = .Documents.Add(CheminCompletWord)
         Set MaSelection = WordApp.Selection
    End With
 
    For I = 1 To AireFichiers.Count
 
             If AireFichiers(I).Offset(0, 2) <> "" Then
 
                OuvertureFichiers AireFichiers(I), AireFichiers(I).Offset(0, 1)
                Set FichierEnCours = ActiveWorkbook
                If AireFichiers(I).Offset(0, 3) = "" Then
                   RechercheAireAcopier FichierEnCours, AireFichiers(I).Offset(0, 2)
                Else
                   RechercheAireAcopier FichierEnCours, AireFichiers(I).Offset(0, 2), AireFichiers(I).Offset(0, 3)
                End If
 
                AireACopier.Copy
                With MaSelection
                     .Goto What:=wdGoToBookmark, Name:=AireFichiers(I).Offset(0, 4)
                     .MoveDown unit:=wdParagraph, Count:=1, Extend:=wdExtend
                     'On le colle dans le doc atuel (word), avec lien avec le tableau sous Excel, sous format image
                     .PasteSpecial Link:=True, DataType:=4, Placement:=wdInLine
                End With
 
                With DocEnCours
                  If .InlineShapes.Count > 0 Then
                     Set MaForme = .InlineShapes(1).ConvertToShape
                     With MaForme
                        '  .ConvertToInlineShape
                          NomAvant = .Name
                          .Name = AireFichiers(I).Offset(0, 4)
                          NomApres = .Name
                          Debug.Print "Nom avant : " & NomAvant & ", nom après : " & NomApres
                          Select Case .Name
                                 Case "Tableau_1", "Tableau_2", "Tableau_3", "Tableau_4"
                                      MettreEnFormeUneFormeShape MaForme
                          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 AireFichiers = Nothing
    Set TableParametres2 = Nothing
    Set MaSelection = Nothing
    Set DocEnCours = Nothing
    Set WordApp = Nothing
 
 
End Sub

[Wilkoo]

J'ai modifié le code pour vous montrer comment on peut modifier le nom d'un objet shape. Pour mettre en forme l'objet Shape, il faut intervenir dès que MaForme est instanciée.

J'ai bien modifié comme vous l'avez écrit, en déclarant NomAvant et NomApres, et le Debug.Print me montre bien que cela a très bien fonctionné pour renommer les formes !

J'ai donc essayé d'adapter le code pour pouvoir ensuite agir sur cette forme. Il n'y a aucune erreur, le code s'exécute, mais aucun changement sur la mise en page... C'est comme si on n'avait rien fait pour les dimensions des images etc ! Je ne vois pas vraiment pourquoi...

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
Option Explicit
 
 
' Référencer la DLL Microsoft Word
 
Public DimensionSouhaitee As String
Public PositionSouhaitee As String
Public AireACopier As Range
 
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
                            Case <s>"Tableau_1", "Tableau_2", "Tableau_3", "Tableau_4"</s>
                                MettreEnFormeUneFormeShape MaForme, InfosFichiers(I).Offset(0, 5), InfosFichiers(I).Offset(0, 6)
                        End Select
                    End With
                End If
            End With
 
 
            'If InfosFichiers(I).Offset(0, 5) = "" Then
            ''Si pas de dimension demandée
                'MettreEnFormeUneFormeShape InfosFichiers(I).Offset(0, 4), InfosFichiers(I).Offset(0, 5), InfosFichiers(I).Offset(0, 6)
                ''DimensionSouhaitee = 0.56 par exemple
                ''PositionSouhaitee = 37 par exemple
            'End If
 
            'ActiveDocument.Shapes("InfosFichiers(I).Offset(0, 4)").Select
                'With Selection.ShapeRange
                    ''On redimensionne l'image
                    '.ScaleWidth DimensionSouhaitee, msoFalse, msoScaleFromTopLeft
                    '.ScaleHeight DimensionSouhaitee, msoFalse, msoScaleFromBottomRight
                    ''On déplace l'image
                    '.IncrementLeft PositionSouhaitee
                    ''.IncrementTop -8.25
                '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
 
'MsgBox "A1:" & AireACopier.Range("A1") & " A2:" & AireACopier.Range("A2") & " B1:" & AireACopier.Range("B1")
End Sub

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
Sub MettreEnFormeUneFormeShape(ByVal ShapeEnCours2 As Word.Shape, DimensionSouhaitee2 As String, PositionSouhaitee2 As String)
 
        With ShapeEnCours2
 
            If DimensionSouhaitee2 <> "" Then
            'S'il y a une dimension demandée
                Set DimensionSouhaitee = DimensionSouhaitee2
                'DimensionSouhaitee = 0.56 par exemple
                .ScaleWidth DimensionSouhaitee, msoFalse, msoScaleFromTopLeft
                .ScaleHeight DimensionSouhaitee, msoFalse, msoScaleFromBottomRight
            End If
            Debug.Print DimensionSouhaitee
 
            If PositionSouhaitee2 <> "" Then
            'S'il y a une dimension demandée
                Set PositionSouhaitee = PositionSouhaitee2
                'PositionSouhaitee = 37 par exemple
                .IncrementLeft PositionSouhaitee
            End If
            Debug.Print PositionSouhaitee
 
            'On fait en sorte que le texte se positionne autour de l'image, et non pas dessous (par défaut)
            With .WrapFormat
                .AllowOverlap = True
                .Side = wdWrapBoth
                .DistanceTop = CentimetersToPoints(0)
                .DistanceBottom = CentimetersToPoints(0)
                .DistanceLeft = CentimetersToPoints(0.32)
                .DistanceRight = CentimetersToPoints(0.32)
                .Type = wdWrapSquare
            End With
        End With
 
End Sub

Les Debug.Print pour PositionSouhaitee et DimensionSouhaitee ne retournent rien

J'ai finalement compris l'utilisation de Select Case et Case, j'ai donc modifié les "Tableau_1", etc avec les noms de mes signets ! Du coup, j'ai d'autres erreurs, mais celle là est réglée ! (Je m'attelle à corriger les autres avant de revenir vers vous en cas d'échec)

(En tout cas, j'ai l'impression de petit à petit comprendre mieux comment tout ça fonctionne grâce à vous ! Merci de passer du temps pour répondre aux questions de ce forum !)

[Wilkoo]

Sur quel fichier avez vous un problème ? Que cherchez-vous à récupérer ?

Eh bien justement, de simples sélections de cases, mais qui contiennent des objets (diagrammes, plusieurs tableaux dans la même sélection, etc). Mais aussi des fichiers qui devraient fonctionner (simple tableau classique)

Je vais tester tout ça à nouveau avec le nouveau code dès que je serai parvenue à faire la mise en forme de mes images !

[Invité]

DimensionSouhaitee2 et PositionSouhaitee2 ne peuvent pas être de type String mais de type Single dans vos paramètres de MettreEnFormeUneFormeShape. Il faut donc tester par rapport à un 0 qui serait présent dans votre tableau d'origine.

PositionSouhaitee n'est pas un objet, mais une variable numérique, donc supprimer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Set PositionSouhaitee = PositionSouhaitee2