Discussion :

[dar06]

Bonjour à tous,

Voici mon problème.
Je suis entrain d'automatiser un test report en exportant via VBA des graphiques et tableaux issus d'Excel. Pas de problème pour le transfert via l'utilisation de signets dans le fichier WORD.
Les graphiques sont de format Shape tandis que les tableaux sont de format InLineShape sachant qu'il y a déjà des Shape et des InLineShape dans le document.
Mon soucis c'est de redimensionner ces graphiques et tableaux sachant que je ne connais pas leur numéro dans le document Word.

Ne peut on pas faire les redimensionnements lors de leur intégration dans le fichier Word?

Merci par avance de votre aide.

Ci joint mon code pour importer les graphiques et les tableaux.

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
k = 0 'permet de compter le nombre de graphiques passés en revue
For i = 1 To Sheets.Count 'passe en revue les onglets du fichier
    Sheets(i).Activate
    name_feuille = Replace(Replace(Sheets(i).Name, ",", ""), "-", "")
'Boucle pour selectionner un à un les graphiques de la feuille active et faire les modifications
 
    For j = 1 To ActiveSheet.ChartObjects.Count
       Sheets(i).ChartObjects(j).Copy 'copie le graphique sélectionné
        k = k + 1 'implémente le compteur de graphiques
        wdDoc.Activate 'active le fichier Word
        If skew_ok = False Then
            deb = wdDoc.Bookmarks("Graph" & k & bande_utile & cut_def & name_feuille).Start   'repère le début du signet concerné
            fin = wdDoc.Bookmarks("Graph" & k & bande_utile & cut_def & name_feuille).End   'repère la fin du signet concerné
            wdDoc.Bookmarks("Graph" & k & bande_utile & cut_def & name_feuille).Range.Select   'permet d'atteindre le signet correspondant à l'emplacement du graphique
            wdApp.Selection.PasteAndFormat (wdChartPicture) 'collage du graphique en format image
            If cut_def = "Azimuth" Then wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft 'met le graphique à gauche
        Else
            deb = wdDoc.Bookmarks("Graph" & k & bande_utile & cut_def & Ant_pos & name_feuille).Start   'repère le début du signet concerné
            fin = wdDoc.Bookmarks("Graph" & k & bande_utile & cut_def & Ant_pos & name_feuille).End    'repère la fin du signet concerné
            wdDoc.Bookmarks("Graph" & k & bande_utile & cut_def & Ant_pos & name_feuille).Range.Select   'permet d'atteindre le signet correspondant à l'emplacement du graphique
            wdApp.Selection.PasteAndFormat (wdChartPicture) 'collage du graphique en format image
            wdApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft 'met le graphique à gauche
        End If
 
        If cut_def = "Azimuth" Then
            If k = 3 Then k = 0
        Else
            If k = 1 Then k = 0
        End If
    Next j
    If cut_def = "Azimuth" Then
        If skew_ok = False Then
            wdDoc.Bookmarks("Tab1" & bande_utile & cut_def & name_feuille).Range.Select
            Sheets(i).Range(Cells(1, 17), Cells(9, 19)).CopyPicture
            wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
        Else
            wdDoc.Bookmarks("Tab1" & bande_utile & cut_def & Ant_pos & name_feuille).Range.Select
            Sheets(i).Range(Cells(1, 17), Cells(9, 19)).CopyPicture
            wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
        End If
    Else
        wdDoc.Bookmarks("Tab1" & bande_utile & cut_def & name_feuille).Range.Select
        Sheets(i).Range(Cells(1, 17), Cells(5, 19)).CopyPicture
        wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
    End If
Next i

[Invité]

Bonjour,

Il vous suffit d'instancier une variable du même type une fois le collage réalisé. Un exemple pour un graphe (inlineshape) récupéré d'Excel

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
 
 
Sub RedimensionnerUnGraphique()
 
Dim DocEnCours As Document
Dim MonGraphe As InlineShape
 
    Set DocEnCours = ActiveDocument
    With DocEnCours
         Set MonGraphe = .InlineShapes(1)
         With MonGraphe
              .Width = 200
              Debug.Print .Width
         End With
         Set MonGraphe = Nothing
    End With
    Set DocEnCours = Nothing
 
End Sub

[dar06]

Bonjour Eric,
Meilleurs voeux pour cette nouvelle année.
Cela ne marche pas car comme je l'ai dit j'ai déjà des InLineShape dans le document.
Le fait d'insérer une nouvelle figure, je ne sais pas où elle est dans la liste des InLineShape du document.
Y a t'il un moyen autre d'insérer un graphe Excel dans Word en sachant l'identifier pour pouvoir faire une mise en forme?

Merci de votre aide.

[Invité]

Bonjour,

Bonne année également.
Logiquement, c'est juste près le collage du graphique que vous pouvez instancier votre variable Shape avec laquelle vous pourrez travailler.

Code :

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

1
2
3
 
  wdApp.Selection.PasteAndFormat (wdChartPicture) 'collage du graphique en format image
 Set MaShape = WdApp.selection

Je n'ai essayé, si vous avez un exemple Word Excel, mettez le en ligne Zippé.

[dar06]

Bonjour Eric,

J'ai fait comme vous l'aviez préconisé mais cela me met une erreur 13 : incompatibilité de type.
J'ai essayé une variable en Shape ou en InLineShape. Même erreur.
Je vous joint en Zip le code, un fichier Excel et un fichier Word simplifié avec les signets.
Merci encore pour votre aide.

[Invité]

Bonjour,

Je regarde dès que je vais pouvoir.

[Invité]

Le code ci-dessous ne traite que le déversement des graphes sur le document Word. J'ai ajouté un onglet Paramètres pour faire la correspondance Onglet, Graphe, Signet.
Avec l'objet MaShape, vous pouvez modifier les dimensions des graphes, mais je pense que vous n'en aurez pas besoin avec la méthode de collage utilisée qui correspond au vidage d'écran ci-dessous.

Pièce jointe 529890

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
 
Option Explicit
 
Sub Export_graph_Word2()
 
Dim WbSheets As Workbook
 
Dim ShGRaphe As Worksheet
Dim AireGraphes As Range
 
Dim WdApp1 As Word.Application
Dim wdDoc As Word.Document
Dim MaShape As Word.Shape
 
Dim Nom_doc As Variant
Dim i As Integer, j As Integer, k As Integer, NbInLineShapes As Integer, NbShapes As Integer ', IndexMatrice As Integer
Dim nilsi As Integer, nsi As Integer, nilsf As Integer, nsf As Integer
 
Dim Message As String, RepertoireDocument As String
 
       'Application.ScreenUpdating = False 'empêche le rafraîchissement automatique de l'écran Excel
 
        Set WbSheets = ActiveWorkbook
 
        With WbSheets.Sheets("Paramètres")
             Set AireGraphes = .ListObjects("TableDesGraphes").ListColumns("Onglet").DataBodyRange
             RepertoireDocument = .Range("RepertoireDocuments")
             ChDir WbSheets.Path
             'If VerifierLeChemin(RepertoireDocument) = True Then ChDir RepertoireDocument
        End With
 
 
        Nom_doc = Application.GetOpenFilename(FileFilter:="Word.Document(*.docx;*.doc),*.docx;*.doc", Title:="Sélectionnez un document Word") 'permet d'ouvrir une fenêtre pour définir le document Word à ouvrir
 
        Set WdApp1 = CreateObject("Word.Application")
 
        With WdApp1
             .Visible = True
             '.ScreenUpdating = False
        End With
        Set wdDoc = WdApp1.Documents.Open(Nom_doc)
 
        With WbSheets
            For i = 1 To AireGraphes.Count 'passe en revue les onglets du fichier
                For j = 1 To .Sheets.Count
                    With .Sheets(j)
                         If .Name = AireGraphes(i) And .ChartObjects.Count > 0 Then
 
                             .ChartObjects(1).Copy 'copie le graphique sélectionné
                             With wdDoc
                                  NbInLineShapes = .InlineShapes.Count
                                  NbShapes = .Shapes.Count
 
                                  For k = 1 To .Bookmarks.Count
                                      If .Bookmarks(k).Name = AireGraphes(i).Offset(0, 2) Then
                                         .Bookmarks(k).Select
                                          WdApp1.Selection.PasteAndFormat wdFormatSurroundingFormattingWithEmphasis ' wdChartPicture
                                          .InlineShapes(NbInLineShapes + 1).ConvertToShape
                                          Set MaShape = .Shapes(NbShapes + 1)
                                          With MaShape
                                               ' A partir de là, vous pouvez modifier l'objet Shape
                                               .Name = AireGraphes(i).Offset(0, 1)
                                               Debug.Print "Nom : " & .Name & ", longueur : " & .Width
                                           End With
                                           Set MaShape = Nothing
                                           Exit For
                                        End If
                                    Next k
                            End With
                        End If
                    End With
                Next j
            Next i
        End With
 
        MsgBox "Fin de l'export des graphiques sur le document Word.", vbInformation
 
        Set WbSheets = Nothing
        Set wdDoc = Nothing
        Set WdApp1 = Nothing
 
End Sub
 
Function VerifierLeChemin(ByVal Chemin2 As String) As Boolean
 
Dim Fso As Object
 
    VerifierLeChemin = False
    Set Fso = CreateObject("Scripting.FileSystemObject")
    VerifierLeChemin = Fso.FolderExists(Chemin2)
    Set Fso = Nothing
 
End Function

[dar06]

Bonjour Eric,
Merci pour votre aide.
Je regarde et adapte le code et je vous tiens au courant.

[dar06]

Bonjour Eric,
J'ai fait les modifications de format directement sur les InlineShape au lieu des Shape.
Cela marche mais:
Le problème c'est que ça marche s'il n'y a pas de Shape ou InlineShape dans le document.
S'il y a que des Shape ou InlineShape avant la zone d'insertion ça marche, mais s'il y en a aussi après l'endroit où l'on met la nouvelle figure, alors on perd la numérotation et c'est une autre figure qui est redimensionnée.

Y a t'il un moyen de compter les Shape ou InlineShape avant un signet dans un document Word et non la totalité?
Dans ce cas cela marcherait dans tous les cas.

Merci d'avance encore pour ton aide.

[Invité]

Si tu as regardé mon code, le principe est de décompter les objets déjà présents pour ensuite instancier une variable de type Shape en incrémentant le nombre d'objets. Ce qui est possible pour une variable Shape l'est aussi pour une variable InlineShape.
Il faut mettre ton code en ligne pour comprendre ce qui ne va pas.

[dar06]

Pour être plus clair.

Quand tu écrit NbInLineShapes = .InlineShapes.Count cela compte tous les InlineShape qu'il y a dans le document Word.

Quand tu insères une nouvelle figure à la fin du document et que tu incrémentes, tu tombe bien sur cette nouvelle figure.
Mais si tu insères cette nouvelle figure au milieu du document (il y a de ce fait des figures existantes avant et après), le fait d'incrémenter le nombre total d'InlineShape ne te permet pas de tomber sur la figure que tu viens d'insérer et quand tu feras une mise en forme, celle-ci s'appliquera à une autre figure.
C'est pourquoi j'ai écrit :

Y a t'il un moyen de compter les Shape ou InlineShape avant un signet dans un document Word et non la totalité?
Dans ce cas cela marcherait dans tous les cas.

J'espère que j'ai été plus clair.
Merci de ton aide.

[Invité]

Ben non, le fait de compter le nombre d'objets juste avant de coller permet d'instancier la variable de l'objet correspondant à la sélection en cours juste après le collage.
Sachant qu'on s'est positionné sur le signet juste avant le collage, le nouvel objet est forcément bien positionné.

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
 
                             .ChartObjects(1).Copy 'copie le graphique sélectionné
                             With wdDoc
                                  NbInLineShapes = .InlineShapes.Count
                                  NbShapes = .Shapes.Count
 
                                  For k = 1 To .Bookmarks.Count
                                      If .Bookmarks(k).Name = AireGraphes(i).Offset(0, 2) Then
                                         .Bookmarks(k).Select  ' Positionnement sur le signet peu importe où dans le document
                                          WdApp1.Selection.PasteAndFormat wdFormatSurroundingFormattingWithEmphasis ' Colle le graphe
                                          .InlineShapes(NbInLineShapes + 1).ConvertToShape  ' S'il s'agit d'un objet InlineShape, il faut simplement instancier un Set MonInLineShape sur cette ligne sans convertir.
                                          Set MaShape = .Shapes(NbShapes + 1)
                                          With MaShape
                                               ' A partir de là, vous pouvez modifier l'objet Shape
                                               .Name = AireGraphes(i).Offset(0, 1)
                                               Debug.Print "Nom : " & .Name & ", longueur : " & .Width
                                           End With
                                           Set MaShape = Nothing
                                           Exit For
                                        End If
                                    Next k
                            End With

[dar06]

Ci joint ton fichier Word modifié avec des Shape et InlineShape avant et après les signets ainsi que ta procédure où j'ai rajouté une mise en forme.

Dans ce cas, la transformation en Shape ne marche pas

Erreur d'exécution '2147467259 (80004005):
La méthode 'ConvertToShape de l'Objet 'InlineShape' a échoué

Et si tu reste en InlineShape, la mise en forme ne se fait pas au bon endroit.

[Invité]

C'est parce qu'il y a déjà des objets shape portant le même nom (ils se superposent comme dans le document joint). J'ai modifié le titre des graphes pour voir si la graphe correspondait bien au signet, et j'ai mis dans les signets dans un autre ordre que dans le premier document pour voir.

Il te faut modifier la ligne où sont nommées les shapes. Le plus simple est d'ajouter le nombre de shapes existantes dans le fichier comme ci-dessous.

Code :

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

1
2
3
4
5
6
7
8
 
                                          With MaShape
                                               ' A partir de là, vous pouvez modifier l'objet Shape
                                                .Height = .Height * 0.5
                                                .Width = .Width * 0.5
                                               .Name = AireGraphes(i).Offset(0, 1) & NbShapes + 1
                                               Debug.Print "Nom : " & .Name & ", longueur : " & .Width
                                           End With

Nb : Tu devrais transformer ton .docx en modèle .dotx, ce qui te permettrait de déverser tes graphes sur un fichier vierge qu'il faudra sauvegarder sous un autre nom.