Bonjour le forum
j'ai un pb avc ma présentation ppt, je vous explique:
j'essaye de copier coller des tableaux excel contenant des graph ds un ppt via VB.
Le truc c ke j'ai 18 tableaux ds 18 classeurs excel que je dois coller ds ce ppt.
Pour l'instant, je pilote ppt depuis excel via le code suivant :
Sub ModifierPresentationExistante()
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Set PptApp = CreateObject("Powerpoint.Application")
PptApp.Visible = True
Set PptDoc = PptApp.Presentations.Open("W:\CGestion\KI\KI reportings\présentation.ppt")
With PptDoc
'copie la plage de cellules dans la feuille Excel active
'--- Ajoute un nouveau slide et le positionne en 2eme position
Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
'copie le 1er graphique contenu dans la feuille Excel active
Feuil1.Range("A1:I30").Copy
'collage dans la 2eme diapositive
Diapo.Shapes.PasteSpecial ppPasteBitmap
'PptDoc.Slides(1).Shapes.PasteSpecial ppPasteMetafilePicture
'Compte le nombre de shapes dans la diapositive:
'le dernier objet inséré correspond à l'index le plus élevé
NbShpe = Diapo.Shapes.Count
'Renomme et met en forme l'objet collé
With Diapo.Shapes(NbShpe)
.Fill.Transparency = 0#
.LockAspectRatio = msoFalse
.Height = 253.88
.Width = 348.88
.Left = 14.12
.Top = 14.12
End With
MsgBox "Opération terminée."
End With
'Sauvegarde la présentation
'dans le meme répertoire que le classeur excel contenant la macro.
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "Presentation.ppt"
'ferme la presentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit
End Sub
Mais je pense que le plus simple serait d'ouvrir chaque classeur excel depuis ppt et de copier chaque tableau. Pb, je ne sais pas si c'est possible et surtout comment faire.
Si vous avez une idée, je suis preneur!
Merci d'avance.
je vous joints le tableau à copier.
j'ai un pb avc ma présentation ppt, je vous explique:
j'essaye de copier coller des tableaux excel contenant des graph ds un ppt via VB.
Le truc c ke j'ai 18 tableaux ds 18 classeurs excel que je dois coller ds ce ppt.
Pour l'instant, je pilote ppt depuis excel via le code suivant :
Sub ModifierPresentationExistante()
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Set PptApp = CreateObject("Powerpoint.Application")
PptApp.Visible = True
Set PptDoc = PptApp.Presentations.Open("W:\CGestion\KI\KI reportings\présentation.ppt")
With PptDoc
'copie la plage de cellules dans la feuille Excel active
'--- Ajoute un nouveau slide et le positionne en 2eme position
Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
'copie le 1er graphique contenu dans la feuille Excel active
Feuil1.Range("A1:I30").Copy
'collage dans la 2eme diapositive
Diapo.Shapes.PasteSpecial ppPasteBitmap
'PptDoc.Slides(1).Shapes.PasteSpecial ppPasteMetafilePicture
'Compte le nombre de shapes dans la diapositive:
'le dernier objet inséré correspond à l'index le plus élevé
NbShpe = Diapo.Shapes.Count
'Renomme et met en forme l'objet collé
With Diapo.Shapes(NbShpe)
.Fill.Transparency = 0#
.LockAspectRatio = msoFalse
.Height = 253.88
.Width = 348.88
.Left = 14.12
.Top = 14.12
End With
MsgBox "Opération terminée."
End With
'Sauvegarde la présentation
'dans le meme répertoire que le classeur excel contenant la macro.
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "Presentation.ppt"
'ferme la presentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit
End Sub
Mais je pense que le plus simple serait d'ouvrir chaque classeur excel depuis ppt et de copier chaque tableau. Pb, je ne sais pas si c'est possible et surtout comment faire.
Si vous avez une idée, je suis preneur!
Merci d'avance.
je vous joints le tableau à copier.
