Discussion :

[pat66]

Bonjour à tous,

Voila je démarre avec PP et je souhaite pouvoir utiliser la macro suicid (excel) afin de limiter, dans le temps, l'utilisation de ma présentation, pensez vous que l'on puisse utiliser la macro suivante qui vérifie la date à l'ouverture de ma présentation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim MyDate, ddd As Date
MyDate = #5/31/2020#
ddd = Date
If (MyDate < ddd) Then Suicide

Dans un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
Sub Suicide()
Dim FName As String
Dim Ndx As Integer
With ThisWorkbook
    .Save
    For Ndx = 1 To Application.RecentFiles.Count
        If Application.RecentFiles(Ndx).Path = .FullName Then
            Application.RecentFiles(Ndx).Delete
            Exit For
        End If
    Next Ndx
    .ChangeFileAccess Mode:=xlReadOnly
    Kill .FullName
    .Close SaveChanges:=False
End With
End Sub

Un grand merci pour votre aide

Patrick

[Invité]

Je vous laisse le soin d'ajouter la ligne qui supprime les fichiers :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
Public MatriceFichiers() As Variant
Public IndexMatrice As Long
 
Sub LancerIdentifierLesFichiers()
 
    Erase MatriceFichiers
    IndexMatrice = 0
 
    IdentifierLesFichiers "D:\XXXXXX", "pptx", CDate("20/05/2020")
 
    If IndexMatrice > 0 Then
       For IndexMatrice = LBound(MatriceFichiers, 2) To UBound(MatriceFichiers, 2)
           Debug.Print MatriceFichiers(1, IndexMatrice) & "\" & MatriceFichiers(0, IndexMatrice)
       Next IndexMatrice
    End If
 
 
End Sub
 
Sub IdentifierLesFichiers(ByVal RepertoireTraite As String, ByVal ExtensionFichier As String, ByVal DateCreation As Date)
 
Dim Fso As Object, Dossier_RepertoireTraite As Object, Fichier As Object, FichiersDuDossier As Object
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier_RepertoireTraite = Fso.getfolder(RepertoireTraite)
    Set FichiersDuDossier = Dossier_RepertoireTraite.Files
 
    For Each Fichier In FichiersDuDossier
        Select Case Fso.GetExtensionName(LCase(Fichier))
               Case LCase(ExtensionFichier)
                    If Fichier.DateCreated < DateCreation Then
                       ReDim Preserve MatriceFichiers(1, IndexMatrice)
                       MatriceFichiers(0, IndexMatrice) = Fichier.Name
                       MatriceFichiers(1, IndexMatrice) = CurDir
                       IndexMatrice = IndexMatrice + 1
                    End If
        End Select
    Next Fichier
 
    Set FichiersDuDossier = Nothing
    Set Dossier_RepertoireTraite = Nothing
    Set Fso = Nothing
 
End Sub

[pat66]

Bonjour et merci de m'aider

comme je vous l'ai dis je n'y connais pas grand chose dans PP, je ne sais pas où mettre le code que vous l'avez gentiment adressé.
Pouvez vous m'expliquer la procédure complète car contrairement à excel, je n'ai ni workbook ni module standart,

Peut être m'envoyer la présentation avec le code je n'aurais plus qu'a copier la procédure dans ma présentation si ce n'est pas trop vous demander

merci encore

Patrick

[Invité]

Vous le faites depuis Excel, Word, mais pas de Powerpoint.

[Invité]

En complément de ma dernière réponse où j'indiquais qu'il ne fallait pas utiliser mon code depuis Powerpoint, une solution existe si une nouvelle présentation issue d'un modèle .potm venait écraser l'ancienne. Dans ce cas un événement pourrait être adjoint au modèle .potm.
Pour cela voir le tuto de Thierry GASPERMENT : POWERPOINT : Gérer les événements