optimisation d'une macro excel-powerpoint

[Mika]

bonjour a tous!
Grace a ce site j'ai reussi a creer une macro qui met à jour un fichier powerpoint à partir des données rentrées dans un fichier excel. Cette macro de mise a jour s'effectue lorsque l'on sauvegarde le fichier excel. Le fichier Powerpoint s'ouvre alors, se sauvegarde et se referme. On voit donc à l'ecran un fichier powerpoint pendant qq secondes. Serait-il possible de rendre cette opération invisible ?

Pour info, voici la macro en question :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'nécéssite d'activer la reference Microsoft Powerpoint 10.0 Object Library
'nécessite aussi la reference Microsoft ActiveX Data Objects 2.0 library
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Set PptApp = CreateObject('Powerpoint.Application')
PptApp.Visible = True '

Set PptDoc = PptApp.Presentations.Open('C:\\pres2.ppt') 'adapter le chemin

With PptDoc
If Range('J18') = 'ok' Then .Slides(3).Shapes('f01').Fill.ForeColor.RGB = RGB(0, 255, 0) Else .Slides(3).Shapes('f01').Fill.ForeColor.RGB = RGB(255, 0, 0)

.Save 'sauvegarder la presentation
End With
PptDoc.Close 'fermer la presentation sauvegardée
PptApp.Quit 'fermer powerpoint
End Sub

 

[MichelXld]

bonsoir Mika

tu peux faire un essai en remplaçant

PptApp.Visible = True

par

PptApp.Visible = False


bonne soirée
MichelXld

 

[Mika]

Merci mais ca ne marche pas ca me met que ce n'est pas autorisé

 

[MichelXld]

rebonsoir

effectivement , tu as raison . je n'avais jamais fait attention à ce point .

supprime la ligne

PptApp.Visible = True

et tu peux essayer

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'nécéssite d'activer la reference Microsoft Powerpoint 10.0 Object Library
'nécessite aussi la reference Microsoft ActiveX Data Objects 2.0 library
Dim PptApp As PowerPoint.Application
Dim PptDoc As PowerPoint.Presentation
Set PptApp = CreateObject('Powerpoint.Application')

Set PptDoc = PptApp.Presentations.Open('C:\\\\\\\\pres2.ppt', WithWindow:=msoFalse)

With PptDoc
If Range('J18') = 'ok' Then .Slides(3).Shapes('f01').Fill.ForeColor.RGB = RGB(0, 255, 0) Else .Slides(3).Shapes('f01').Fill.ForeColor.RGB = RGB(255, 0, 0)

.Save 'sauvegarder la presentation
End With
PptDoc.Close 'fermer la presentation sauvegardée
PptApp.Quit 'fermer powerpoint
End Sub


bonne soirée
MichelXld

Message édité par: michelxld, à: 21/03/2006 21:41

 

[Mika]

Merci MichelXLD ca marche ! tu es vraiment trop fort! continuez a faire un aussi beau site il est super !!