XL 2019 Rafraichir automatiquement

[Yassin9]

Bonjour à tous,

Déjà bon dimanche
Alors mon probléme est que je cherche un code VBA pour PowerPoint qui permet de mettre à jour automatiquement ce fichier selon un intervalle de temps de 5 minutes par exemple même en diaporama.
Car j'ai lié Excel à un PPT.

Merci à vous

 

[job75]

Bonjour Yassin9,

On peut facilement piloter PowerPoint depuis Excel en VBA.

Téléchargez les fichiers joints dans le même dossier (le bureau) et exécutez cette macro :

Dim t 'mémorise la variable

Sub Lancer_PPT()
Dim delai, PPT As Object, P As Object
delai = 1 'en minutes
On Error Resume Next
Application.OnTime t, "Lancer_PPT", , False 'RAZ
Set PPT = GetObject(, "PowerPoint.Application")
If PPT Is Nothing Then Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = False
If PPT.ActivePresentation Is Nothing Then
    PPT.Presentations.Open ThisWorkbook.Path & "\Mon PPT.pptx"
Else
    For Each P In PPT.Presentations
        P.Save 'enregistre
    Next
    AppActivate Application.Caption
    MsgBox "Toutes les presentations sont enregistrées", , "PowerPoint"
End If
PPT.Visible = True
AppActivate PPT.Caption
t = Now + delai / 1440
Application.OnTime t, "Lancer_PPT" 'relance le processus
End Sub

J'ai mis un délai d'attente de 1 minute.

A+

 

[job75]

Bonjour Yassin9, le forum,

En fait le masquage de PPT par PPT.Visible = False ne se faisait pas.

En utilisant PPT.WindowState = 2 il n'y a plus de problème pour l'affichage du message Excel :

Dim t 'mémorise la variable

Sub Lancer_PPT()
Dim delai, PPT As Object, P As Object
delai = 1 'en minutes
On Error Resume Next
Application.OnTime t, "Lancer_PPT", , False 'RAZ
Set PPT = GetObject(, "PowerPoint.Application")
If PPT Is Nothing Then Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
If PPT.ActivePresentation Is Nothing Then
    PPT.Presentations.Open ThisWorkbook.Path & "\Mon PPT.pptx"
Else
    For Each P In PPT.Presentations
        P.Save 'enregistre
    Next
    PPT.WindowState = 2 'Minimized
    AppActivate Application.Caption
    MsgBox "Toutes les presentations sont enregistrées", , "PowerPoint"
End If
PPT.WindowState = 3 'Maximized
AppActivate PPT.Caption
t = Now + delai / 1440
Application.OnTime t, "Lancer_PPT" 'relance le processus
End Sub

A+

 

[job75]

Maintenant si l'on veut lancer un diaporama voyez ce fichier (3) :

Dim t, n% 'mémorise les variables

Sub Lancer_PPT()
Dim delai, PPT As Object
delai = 1 / 6 'en minutes => 10 secondes
On Error Resume Next
Application.OnTime t, "Lancer_PPT", , False 'RAZ
Set PPT = GetObject(, "PowerPoint.Application")
If PPT Is Nothing Then Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
If PPT.ActivePresentation Is Nothing Then PPT.Presentations.Open ThisWorkbook.Path & "\Diaporama PPT.pptx"
n = n + 1
If n > PPT.ActivePresentation.Slides.Count Then n = 1
PPT.ActivePresentation.Slides(n).Select
PPT.WindowState = 3 'Maximized
AppActivate PPT.Caption
t = Now + delai / 1440
Application.OnTime t, "Lancer_PPT" 'relance le processus
End Sub