comment laner une macro powerpoint sur répertoire

[tchegus]

En cherchant à savoir comment rattacher une macro powerpoint sur un
ensemble de fichier, j'ai touvé sur ce forum, une macro qui agit sur
un ensemble de fichier dans un répertoire...
Cependant, je ne sais pas comment lier cette macro à l'ensemble du répertoire.
Je sais le lier à un fichier, mais à un répertoire, c'est quelque que j'ignore!!!
Ma question est comment rattacher une macro à l'ensemble du répertoire,
de manière à ce qu'elle agisse sur tous les fichiers?
Merci à vous de me répondre.

NB: Je suis très débutant dans les maco et surtout dans VBA.

voila le lien question. Merci de me donner un coup de main.
pour le moment je fais une exécution de ma macro
fichier par fichier, alors que je veux le lancer sur
l'ensemble du répertoire.

Vous devez être connecté pour voir les liens.

 

[zeb]

Un bout de code ou le lien vers le topic en question ?

 

[tchegus]

Un bout de code ou le lien vers le topic en question ?

NB: Je suis très débutant dans les maco et surtout dans VBA.

voila le lien question. Merci de me donner un coup de main.
pour le moment je fais une exécution de ma macro
fichier par fichier, alors que je veux le lancer sur
l'ensemble du répertoire.

Vous devez être connecté pour voir les liens.

[...] htm#t22415

 

[kiki29]

A Adapter à tes besoins

Option Explicit

'=======================================================
'   Dans environnement VBA
'   Menu Outils | Références
'   cocher Microsoft Scripting Runtime
'=======================================================

'=======================================================
'    A Adapter selon les cas à traiter
'=======================================================
Const NomFichierRch = "*"
Const DossierRacine As String = "C:\Tst"
Const TypeFichier As String = "xlsx"
'=======================================================

Dim NbFichiers As Long
Dim Tableau() As String

Sub Test()
Dim DossierOk As String
    Erase Tableau
    NbFichiers = 0
    DossierOk = BackSlashDossier(DossierRacine)
    ' Ici recherche récursive dans Dossier / Sous Dossiers
    ' à partir de DossierRacine sinon
    ' ListeFichiers DossierOk, False
    ListeFichiers DossierOk, True
End Sub

Private Sub ListeFichiers(ByVal NomDossierSource As String, ByVal InclureSousDossiers As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
Dim i As Long
Dim Extension As String, VerifNom As Boolean

    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(NomDossierSource)

    For Each Fichier In DossierSource.Files
        Extension = UCase(FSO.GetExtensionName(Fichier))
        VerifNom = Fichier.Name Like NomFichierRch
        If VerifNom And UCase(TypeFichier) = Extension Then
            NbFichiers = NbFichiers + 1
            ReDim Preserve Tableau(1 To NbFichiers)
            Tableau(NbFichiers) = Fichier.Path
        End If
    Next Fichier

    If InclureSousDossiers Then
        For Each SousDossier In DossierSource.SubFolders
            ListeFichiers SousDossier.Path, True
        Next SousDossier
    End If

    Set Fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing

    If NbFichiers > 0 Then
        For i = LBound(Tableau) To UBound(Tableau)
            ' Placer ici appel à la procédure de traitement des fichiers
            ' Tableau(i) contient les fichiers à traiter avec leur chemin d'accès
        Next
    End If
End Sub

Private Function BackSlashDossier(ByVal TstDossier As String) As String
    If Right(TstDossier, 1) <> "\" Then TstDossier = TstDossier & "\"
    BackSlashDossier = TstDossier
End Function