Activer PPT à partir d'Excel

[Renaud_ACN]

Bonjour,

Je cherche à coller des Enhanced Metafile copié à partir d'excel, pour les mettre dans PPT, à la bonne taille et à la bonne dimension.

J'arrive à coller l'image EnhancedMetafile, mais ensuite je n'arrive pas à la modifier car j'ai l'impréssion que le code tourne pour excel mais pas pour PPT. Il doit me manquer une phrase de liaison pour activer PPT et ensuite lancer la ligne de code pour modifier l'image. Ci dessous mon code à date :

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
Sub GeneratePpt11()
  Dim ppt As Object
  Set ppt = CreateObject("PowerPoint.Application")
  ppt.Visible = True
  Dim Pres As PowerPoint.Presentation
  Set Pres = ppt.Presentations.Open(Filename:="D:\Test.ppt")
 
'Coller le tableau excel en format Enhanced Metafile
  ActiveSheet.Range("B2:H5").Select
  Selection.Copy
  Pres.Slides(1).Shapes.PasteSpecial ppPasteEnhancedMetafile
 
 'Trouver l'image dans la slide
  For Each Shape In Pres.Slides(1).Shapes
     If Shape.Type = msoPicture Then
'***** C'est ici que ça bloque*******
        Pres.Slides(1).Shapes (Pres.Slides(1).Shapes.Count)
        .Left = 0 'position horizontale dans le slide
        .Top = 0 'position verticale dans le slide
        .Height = 50 'hauteur image
        .Width = 50 'largeur image
        End With
    End If
  Next Shape
End Sub

Une âme généreuse pour une réponse??

[SilkyRoad]

bonjour

Tu peux essayer cette adaptation

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
  Dim ppt As PowerPoint.Application
  Dim Pres As PowerPoint.Presentation
 
  Set ppt = CreateObject("PowerPoint.Application")
  ppt.Visible = True
 
  Set Pres = ppt.Presentations.Open(Filename:="C:\Test.ppt")
 
'Coller le tableau excel en format Enhanced Metafile
  ActiveSheet.Range("B2:H5").Copy
  Pres.Slides(1).Shapes.PasteSpecial ppPasteEnhancedMetafile
 
  With Pres.Slides(1).Shapes(Pres.Slides(1).Shapes.Count)
    .Left = 0 'position horizontale dans le slide
    .Top = 0 'position verticale dans le slide
    .Height = 500 'hauteur image
    .Width = 400 'largeur image
  End With

bonne journée
michel