Discussion :

[ouskel'n'or]

Bonjour vous tous nombreux qui fréquentez ce forum le dimanche soir

........................................................1

Je cherche à lister les fichiers d'un répertoire et de ses sous-répertoires en vue de l'insertion de ces fichiers dans une diapositive.
Avec Dir et pour un seul répertoire, (exemple de l'aide en ligne sur Dir à peine modifiée) l'insertion et la répartition des images dans la diapo se fait... les doigts dans le nez !

Le code qui fonctionne :

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
Sub InsèreLesFichiersDunRépertoireAvecDirSansProblèmeAucun()
Dim rep As String, NomFich As String, NomRep(), i As Integer, Haut as integer, Gauche as integer
    rep = "C:\Code fluvial\1 - Les Panneaux d'Interdiction\"
    NomFich = Dir(rep)
    Haut = 0
    Gauche = 0
    Do While NomFich <> ""
        Debug.Print rep & NomFich
        ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=rep & NomFich, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=Gauche, Top:=Haut, Width:=175, Height:=79).Select
        With ActiveWindow.Selection.ShapeRange
            .LockAspectRatio = msoFalse
            .Height = 80#
            .Width = 80#
            .Left = Gauche
            .Top = Haut
        End With
        If Gauche < 640 - 80 Then
            Gauche = Gauche + 82
            Else
            Haut = Haut + 82
            Gauche = 0
        End If
        NomFich = Dir()
    Loop
End Sub

........................................................2

Maintenant je liste les répertoires d'un répertoire avec Dir et tente d'insérer toutes les images de ces sous-répertoires (en un premier temps dans une même diapo)
Là, comme j'utilise une procédure paramétrée, Dir perd l'origine et ne liste que le premier sous-répertoire du répertoire principal et buggue pour le second.
Message d'erreur sur Dir() "Argument ou appel de procédure incorrect"

Le code suivant fonctionne donc pour le premier sous-répertoire ***

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Appel()
Dim Rep As String, NomFich As String, Chemin As String
    Rep = "C:\Code fluvial\"
    NomFich = Dir(Rep, vbDirectory)
    Do While NomFich <> ""
        If NomFich <> "." And NomFich <> ".." Then
            Chemin = Rep & NomFich & "\"
            MsgBox Chemin
            ListerLesFichiersAvecDir Chemin
        End If
        NomFich = Dir() '*** et buggue ici pour le second ***
    Loop
End Sub

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
Sub ListerLesFichiersAvecDir(Rep)
Dim NomFich As String, NomRep(), i As Integer, Haut As Integer, Gauche As Integer
    NomFich = Dir(Rep)
    Haut = 0
    Gauche = 0
    Do While NomFich <> ""
        Debug.Print Rep & NomFich
        ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=Rep & NomFich, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=Gauche, Top:=Haut, Width:=175, Height:=79).Select
        With ActiveWindow.Selection.ShapeRange
            .LockAspectRatio = msoFalse
            .Height = 80#
            .Width = 80#
            .Left = Gauche
            .Top = Haut
        End With
        If Gauche < 640 - 80 Then
            Gauche = Gauche + 82
            Else
            Haut = Haut + 82
            Gauche = 0
        End If
        NomFich = Dir()
    Loop
End Sub

........................................................3

A présent, je liste les répertoires en utilisant FSO et envoie les sous-répertoires en paramètre à la procédure ListerLesFichiersParOrdreAlpha.
Et là, sur la ligne encadrée par des "*" j'ai le message d'erreur "Shapes (unknown member) : Out of memory error" dès le premier fichier.
Je précise que si je supprime cette ligne ou ajoute une gestion d'erreurs, les fichiers de tous les sous-répertoires sont bien listés, leurs chemins sont corrects et complets dans la fenêtre exécution.
D'abord yakatester

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub Appel2()
Dim fs As Scripting.FileSystemObject
Dim Rep As String, Chemin As String, element As Object
    Set fs = New Scripting.FileSystemObject
    Rep = "C:\Code fluvial"
        For Each element In fs.GetFolder(Rep).SubFolders
            Chemin = element.Path
            'Debug.Print Chemin
            ListerLesFichiersParOrdreAlpha Chemin & "\"
        Next element
End Sub

Code corrigé

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
Sub ListerLesFichiersParOrdreAlpha(Chemin)
Dim fs as object, i As Integer, Haut As Integer, Gauche As Integer
    Haut = 0
    Gauche = 0
    Set fs = Application.FileSearch
    With fs
        .LookIn = Chemin
        .FileType = 1
        If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
'*******La ligne qui fonctionne maintenant
                ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=.FoundFiles(i), LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=Gauche, Top:=Haut, Width:=175, Height:=79).Select
'***************************
            Next i
          Else
            MsgBox "Fichier pas trouvé, cékiennapa."
        End I
    End With
End Sub

Une explication me siérait assez, oui !
A défaut d'une solution

Bref, si vous voyez l'erreur, vous être bien gentil de m'en faire part.
Par avance, merci

PS - J'ai bien sûr une possibilité un peu lourde pour faire fonctionner la solution 2 en créant un tableau des sous-répertoires comme paramétre de la procédure ListerLesFichiersAvecDir mais je trouve pas ça beau et je perds le tri alpha que permet fso simplement.

[ouskel'n'or]

Trouvé !
Contrairement à Dir qui n'indique qu'un nom de fichier ou de répertoire, .FoundFiles(i) contient le tout, chemin et nom de fichier, ce que j'avais oublié
Je corrige le code du post précédent pour ceux que ça intéressent.

(chavais bien que c'était une bêêêtise !)