Bonjour à tous,
Je voudrais pouvoir piloter powerpoint avec Excel, donc la, le code VBA devrait créer une présentation PPT à partir d'excel mais quand je le lance, il me renvoie le message d'erreur suivant :
Erreur de compilation : Sub ou Fonction non définie
avec une erreur sur la 1ere ligne.
Ci dessous le code :
====================================================================
Sub NouvellePresentation()
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Sh As PowerPoint.Shape
Dim Cs1 As ColorScheme
Dim NbShpe As Integer
Set PptApp = CreateObject("Powerpoint.Application")
Set PptDoc = PptApp.Presentations.Add
With PptDoc
'--- Ajoute un Slide
.Slides.Add Index:=1, Layout:=ppLayoutBlank
'Crée une zone de texte (AddLabel)
Set Sh = .Slides(1).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
Left:=100, Top:=100, Width:=150, Height:=60)
'insère la valeur de la Cellule A1 dans une zone de texte
Sh.TextFrame.TextRange.Text = Range("A1")
'Modifie la couleur du texte
Sh.TextFrame.TextRange.Font.Color = RGB(255, 100, 255)
'--- Ajoute un nouveau slide et le positionner en 2eme position
Set Diapo = .Slides.Add(Index:=2, Layout:=ppLayoutBlank)
'copie le 1er graphique contenu dans la feuille Excel active
ActiveSheet.ChartObjects(1).Copy
'collage dans la 2eme diapositive
Diapo.Shapes.Paste
'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)
.Name = "monGraph" 'personnalise le nom
.Left = 150 'définit la position horizontale dans le slide
.Top = 100 'définit la position verticale dans le slide
.Height = 300 'hauteur
.Width = 400 'largeur
End With
'--- Modifie la couleur de fond dans les différents Slides
Set Cs1 = .ColorSchemes(3)
Cs1.Colors(ppBackground).RGB = RGB(225, 233, 200)
.SlideMaster.ColorScheme = Cs1
End With
'Sauvegarde la présentation
'dans le meme répertoire que le classeur excel contenant la macro.
PptDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & "NouvellePresentation.ppt"
'ferme la presentation
PptDoc.Close
'ferme powerpoint
PptApp.Quit
MsgBox "Opération terminée."
End Sub
PptApp.Quit
MsgBox "Opération terminée."
End Sub
===================================================================
En vous remerciant d'avance :D
A bientot
Fred43st
Configuration: Windows XP
Firefox 1.5.0.12