Proportions des métafichiers copier coller dans ppt par macro excel

[Anais51]

Bonjour!

Me revoilà avec un petit soucis lors de la création de mes macros. Je m'explique.
J'ai conçu une petite macro capable de copier coller des sortes de TCD dans des fichiers Excel sélectionné afin de les coller dans des slides précis d'un fichier power point type.
Tout cela fonctionne parfaitement à un petit détail pret: le collage spéciale en métafichier ne veux pas quitter les proportions de base quelques soit les données sélectionné dans la macro.

Voici un extrait de la macro:

'Sélectionne et transforme le tableau Excel
Workbooks.OpenText Filename:= _
"C:chemin\doc.xls"
Sheets("onglet").Select
Range("E2:H2").Select
ActiveCell.FormulaR1C1 = "Bla1"
Range("E3").Select
ActiveCell.FormulaR1C1 = "Bla2"
Range("K2:L2").Select
ActiveCell.FormulaR1C1 = "Bla3"
Range("D2:L12").Copy

'Sélectionne le Slide 8 et colle le tableau
PPTDoc.Slides(8).Shapes.PasteSpecial ppPasteEnhancedMetafile
NbShpe = PPTDoc.Slides(8).Shapes.Count
With PPTDoc.Slides(8).Shapes(NbShpe)
.Left = 15
.Top = 100
.Height = 10000
.Width = 350
End With

Quelque soit la hauteur "Height" que je met elle ne change pas tant que la largeur "Width" n'augmente pas d'autant.
En gros si l'image du fichier fait 1000 x 500 je pourrais la modifier de telle façon qu'elle face 500 x 250 mais je suis incapable de changer les proportions et de faire 700 x 250 par exemple.
Je suis débutante en VBA, enfin je me débrouille avec ce que je trouve peut-être est-ce du à mon code?

Merci d'avance

 

[Guest]

Re : Proportions des métafichiers copier coller dans ppt par macro excel

Bonjour,

En mettant la propriété .LockAspectRatio = True et en ne modifiant que la hauteur ou la largeur, vba adaptera l'autre en conséquence pour garder les proportions.

Macro faite à partir de PowerPoint:

Sub ImporterCellules()
    Dim app As Object
    Set app = GetObject("D:\Mes Documents\Classeur.xls")
    app.sheets("Discussions").Range("A3:E13").Copy
    With ActivePresentation.Slides(1)
        .Shapes.PasteSpecial ppPasteEnhancedMetafile
        With .Shapes(.Shapes.Count)
            .LockAspectRatio = True
            .Left = 15
            .Top = 15
            .Height = 150
        End With
    End With
    Set app = Nothing        
End Sub

A+

 

[Anais51]

Re : Proportions des métafichiers copier coller dans ppt par macro excel

Re,

Je suis sur Excel et justement je ne veux pas garder les proportions mais l'inverse! Je n'arrive pas par exemple a avoir la hauteur que je désire d'où le ".Height = 10000" dans mon code, en fait quelque soit la hauteur "Height" que je met mon graphique reste proportionel à ce qu'il était.

 

[Guest]

Re : Proportions des métafichiers copier coller dans ppt par macro excel

Re,

Eh ben au lieu de mettre LockAspectRatio = True tu mets LockAspectRatio = False.

Et peu importe que tu travailles à partir d'excel ou powerpoint les propriétés sont les mêmes pour les shapes.

A+

 

[Anais51]

Re : Proportions des métafichiers copier coller dans ppt par macro excel

Ca marche!

Merci