XL 2019 Rafraichir automatiquement

Yassin9

XLDnaute Junior
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

XLDnaute Barbatruc
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 :
Code:
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+
 

Pièces jointes

  • Piloter PPT(1).xlsm
    17.4 KB · Affichages: 6
  • Mon PPT.pptx
    32.9 KB · Affichages: 5

job75

XLDnaute Barbatruc
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 :
VB:
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+
 

Pièces jointes

  • Piloter PPT(2).xlsm
    17.8 KB · Affichages: 1
  • Mon PPT.pptx
    32.9 KB · Affichages: 1

job75

XLDnaute Barbatruc
Maintenant si l'on veut lancer un diaporama voyez ce fichier (3) :
Code:
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
 

Pièces jointes

  • Piloter PPT(3).xlsm
    17.7 KB · Affichages: 2
  • Diaporama PPT.pptx
    35.3 KB · Affichages: 1

Discussions similaires

Réponses
5
Affichages
271

Statistiques des forums

Discussions
315 085
Messages
2 116 074
Membres
112 650
dernier inscrit
badi44