Discussion :

[Pierre69200]

Bonjour !
J'ai le code ci-dessous, Il s'agit d'une liste qui affiche les fichiers.pdf présent dans un dossier:

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
For j = 1 To ActiveSheet.Range("K65000").End(xlUp).Row
    If Cells(j, 11) <> "" Then     'Si colonne K est rempli
    Dim tabl() 'Créer une liste déroulante
       Dim t As Byte
 
        t = 1
        ReDim tabl(t)
        repertoire = ThisWorkbook.Path & "\" & ActiveSheet.Name & "\" & Range("K" & j).Value 'entrez le nom du repertoire ou trouver les fichiers
       nf = Dir(repertoire & "\*.pdf*")
 
        Do While nf <> ""
            tabl(t) = nf
            t = t + 1
            ReDim Preserve tabl(t)
            nf = Dir ' suivant
       Loop
 
        With Sheets(ActiveSheet.Name).Cells(j, 23).Validation 'Entrez le numero de la feuille ainsi que la cellule correspondante
        .Delete
         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(tabl, ",")
        End With
    End If
 
    Next j
    End Sub

Est-il possible d'afficher les valeur de la liste dans l'ordre inverse ? J'ai vu sur internet des .Reverse mais pas moyen que cela fonctionne j'ai des erreurs à chaque fois.
Merci

[Thautheme]

Bonjour Pierre, bonjour le forum,

Peut-être comme ça (non testé) :

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
Dim tabl() 'Créer une liste déroulante
Dim TabInv() As Variant
Dim t As Byte
Dim I As Integer
Dim J As Integer
 
For J = 1 To ActiveSheet.Range("K65000").End(xlUp).Row
    If Cells(J, 11) <> "" Then     'Si colonne K est rempli
        t = 1
        ReDim tabl(t)
        repertoire = ThisWorkbook.Path & "\" & ActiveSheet.Name & "\" & Range("K" & J).Value 'entrez le nom du repertoire ou trouver les fichiers
        nf = Dir(repertoire & "\*.pdf*")
        Do While nf <> ""
            tabl(t) = nf
            t = t + 1
            ReDim Preserve tabl(t)
            nf = Dir ' suivant
        Loop
        J = 0
        ReDim TabInv(UBound(tabl, 1))
        For I = UBound(tabl, 1) To LBound(tabl, 1) Step -1
            TabInv(J) = tabl(I)
            J = J + 1
        Next I
        With Sheets(ActiveSheet.Name).Cells(J, 23).Validation 'Entrez le numero de la feuille ainsi que la cellule correspondante
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(TabInv, ",")
        End With
    End If
Next J
End Sub

[Pierre69200]

Bonjour !
Merci d'avoir pris le temps de trouver une solution à mon problème ! Mais le programme ne marche pas, j'ai l'impression que la macro ne s'arrete jamais et cela à fait planter mon classeur ^^

[kiki29]

Salut, regarde Liste des fichiers d'un dossier ( Win 32/64 Bits ) et adapte à ton contexte.

[Invité]

bonjour,

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
Sub test()
Dim T()
T = Array("a", "b", "c", "d", "e")
Tier T
End Sub
 
Sub Tier(tabl)
For i = 1 To UBound(tabl)
   If tabl(i) > tabl(i - 1) Then
    T = tabl(i)
     tabl(i) = tabl(i - 1)
      tabl(i - 1) = T
      i = i - 2
      If i < 0 Then i = 0
   End If
Next i
End Sub

[Thautheme]

Bonjour le fil, bonjour le forum

Bonjour !
Merci d'avoir pris le temps de trouver une solution à mon problème ! Mais le programme ne marche pas, j'ai l'impression que la macro ne s'arrete jamais et cela à fait planter mon classeur ^^

Pas étonnant ! j'ai utilisé la même variable J pour deux boucles différentes... Désolé. Le code rectifié :

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
Sub Macro1()
Dim tabl() 'Créer une liste déroulante
Dim TabInv() As Variant
Dim t As Byte
Dim I As Integer
Dim J As Integer
Dim K As Integer
 
For J = 1 To ActiveSheet.Range("K65000").End(xlUp).Row
    If Cells(J, 11) <> "" Then     'Si colonne K est rempli
        t = 1
        ReDim tabl(t)
        repertoire = ThisWorkbook.Path & "\" & ActiveSheet.Name & "\" & Range("K" & J).Value 'entrez le nom du repertoire ou trouver les fichiers
        nf = Dir(repertoire & "\*.pdf*")
        Do While nf <> ""
            tabl(t) = nf
            t = t + 1
            ReDim Preserve tabl(t)
            nf = Dir ' suivant
        Loop
        ReDim TabInv(UBound(tabl, 1))
        For I = UBound(tabl, 1) To LBound(tabl, 1) Step -1
            TabInv(K) = tabl(I)
            K = K + 1
        Next I
        With Sheets(ActiveSheet.Name).Cells(J, 23).Validation 'Entrez le numero de la feuille ainsi que la cellule correspondante
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(TabInv, ",")
        End With
    End If
Next J
End Sub

[Invité]

Effectivement Thauthème,
Dans ce cas de figure ton traitement est plus efficace que le mien!

[Pierre69200]

Je vous remercie vraiment de m'avoir aidé !

Je me suis finalement servi de la fonction Reversarray ! Mais je vais voir vos codes et essayer de les comprendre.
Merci encore

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
     tabl=reversarray(tabl)
 
 
Function reversarray(tabl)
Dim rtabl()
ReDim rtabl(LBound(tabl, 1) To UBound(tabl, 1))
     For i = LBound(tabl) To UBound(tabl) + IIf(LBound(tabl) = 1, 1, 0)
     rtabl(UBound(tabl) - i) = tabl(i)
     Next i
     reversarray = rtabl
End Function