[VBA-W] Diminution taille graphes [Résolu]

[dev81]

J'insere des graphes d'excel dans word avec le code qui suit:
Et je voudrais diminuer la taille de mes graphes voir meme les regler pour les avoir tous identiques.

Quelqu'un aurai-t-il une idée?Merci d'avance de vos contributions.

code pour l'insertion de graphiques:

Code :

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
Sub CopieTableauEtGrapheVersWord(Path As String, Feuille1 As String, _
         Plage As String, Feuille2 As String)
'insertion de la feuille 1 excel
'insertion de tous les graphes de la feuille 2

    Dim XlAppli As Object
    Dim XlCl As Workbook
    Dim Xlfl As Worksheet 'Feuille 1 avec le tableau
    Dim Xlf2 As Worksheet 'Feuille 2 avec le graphique
    Dim obj As ChartObject
    
        Set XlAppli = CreateObject("Excel.Application") '< L'appli Excel
        Set XlCl = XlAppli.Workbooks.Open(Path) '< le classeur
        Set Xlfl = XlCl.Worksheets(Feuille1) '< la feuille
        With Xlfl
            .Range(Plage).Copy ' < La Plage
        End With
    
        On Error Resume Next
        'Colle la plage Excel avec liaison à l'emplacement du curseur
        Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:= _
            wdInLine, DisplayAsIcon:=False
        DoEvents
        VidePressePapier
        
        Set Xlf2 = XlCl.Worksheets(Feuille2) '< la feuille

        For Each obj In Xlf2.ChartObjects
            obj.Chart.ChartArea.Copy
            Selection.Paste '*****Probleme ICI
            DoEvents
          
        Next obj
        VidePressePapier
        
        XlCl.Close False
        XlAppli.Quit
        Set XlAppli = Nothing
        Set XlCl = Nothing
        Set Xlfl = Nothing
        Set Xlf2 = Nothing

End Sub

[dadavyvy]

En fait j'ai essayé de les redimensionner dans Word et ca ne marche pas, car il modifie la plage Excel visible :

Code :

1
2
3
4
5
6
Selection.Paste
With ThisDocument.InlineShapes(ThisDocument.InlineShapes.Count)
    .lookAspectRatio = False
    .Height = 283.45
    .Width = 425.2
End With

Il faut donc modifier la taille dans Excel, puis copier dans Word et fermer Excel sans enregistrer :

Code :

1
2
3
4
5
6
7
8
9
For Each obj In Xlf2.ChartObjects
    obj.Height = 283.45 'en pixel
    obj.Width = 425.2 'en pixel
    obj.Chart.ChartArea.Copy
    Selection.Paste
    DoEvents
Next obj
 
XlCl.Close False 'Impératif, sinon fichier Excel sera modifié