Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Futur Membre du Club
    Macro qui vérifie la date et si dépassée fait disparaître le PPTX
    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

  2. #2
    Expert éminent sénior
    Citation Envoyé par pat66 Voir le message

    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
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  3. #3
    Futur Membre du Club
    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

  4. #4
    Expert éminent sénior
    Citation Envoyé par pat66 Voir le message

    Vous le faites depuis Excel, Word, mais pas de Powerpoint.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  5. #5
    Expert éminent sénior
    Citation Envoyé par pat66 Voir le message

    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
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter