Problème avec une listbox

Question

Bonjour, J'ai un problème avec une listbox.. Voici un descriptif : l'utilisateur choisit le répértoire ou il faut lister les .doc ensuite j'aimerai pouvoir tout lister dans une listBox mais je sais aps trop comment faire... Voici mon code : ce qu'il faut déclarer en haut Option Compare Database Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Public Enum NetWork WithNetworkFolders = 0 WithoutNetworkFolders = 2 End Enum Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _ As Long Const BIF_RETURNONLYFSDIRS = &H1 Const BIF_USENEWUI = &H40 mon bouton parcourir : Private Sub btn_parcourir_Click() Me.edit_repertoire = SelectFolder("D:", WithoutNetworkFolders) If IsNull(edit_repertoire) Or Len(edit_repertoire) = 0 Then btn_lister.Visible = False Else btn_lister.Visible = True End If End Sub la fonction SelectFolder : Public Function SelectFolder(Optional Folder As String = "" _ , Optional NetWorkFolders As NetWork = WithNetworkFolders _ ) As String Dim X As Long, bi As BROWSEINFO, dwIList As Long Dim szPath As String, wPos As Integer If Folder "" Then Folder CurrentProject.Path With bi .hOwner = hWndAccessApp .lpszTitle = "Sélectionnez votre dossier et cliquez sur OK" .ulFlags = BIF_RETURNONLYFSDIRS _ Or BIF_USENEWUI _ Or NetWorkFolders End With dwIList = SHBrowseForFolder(bi) szPath = Folder & Space$(512 - Len(Folder)) X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath) If X Then wPos = InStr(szPath, Chr(0)) SelectFolder = Left$(szPath, wPos - 1) Else SelectFolder = "" End If End Function je rend visible mon bouton lister : Private Sub edit_repertoire_Change() If IsNull(edit_repertoire.Text) Or Len(edit_repertoire.Text) = 0 Then btn_lister.Visible = False Else btn_lister.Visible = True End If End Sub fonction de mon bouton lister (c'est la ou je bloque :S) Private Sub btn_lister_Click() Dim ext As String Dim Ctr As Integer Const myRep = "edit_repertoire.Text" ' Voir s'il ne faut pas definir repertoire... ext = Dir(myRep & "*.doc") List_rep.Visible = True List_rep.DefaultValue = "" Do While ext <> "" List_rep.ControlSource = ext ext = Dir Loop List_rep.ListStyle = fmListStyleOption Next End Sub J'ai essayé de changé ma procédure btn_list click par : Private Sub btn_lister_Click() Dim ext As String Const myRep = "edit_repertoire.Text" ' Voir s'il ne faut pas definir repertoire... ext = Dir(myRep & "*.doc") List_rep.Visible = True List_rep.RowSource = "" Do While ext <> "" List_rep.RowSource = List_rep.RowSource & ext & ";" ext = Dir Loop 'List_rep.ListStyle = fmListStyleOption End Sub Mais sans résultat...Si qqun pourrait m'aider ca serait vraiment sympa...

Twinuts · Answer

Salut,

tu es dans le bar ici pas sur vb, je redirige donc sur vb

------------------------------------
"On n'est pas au resto : ici on ne fait pas dans les plats tout cuits ..."

WORA

ushiwasasuke · Answer

oops dsl  mais merci pour le déplacement 

Qqun a-t-il une idée pour mon problème ?

TomIlliev · Answer

Salut
Voici une sub pour lister les fichiers d'un dossier dans une liste

Sub LoadFileName(Lst as ListBox, Byval Path as String)
      with lst
              .visible = true
               .clear
  path=Dir(Path)
            do while not path=""
                   .additem Path
                   path=dir
           loop
end with
end sub 

 LoadFileName List1, "edit_repertoire.Text\*.Doc"

Il faut faire Attention à bien définir le chemin de début 
A+
TomIlliev

mortalino · Answer

Salut, il y a aussi la possibilité d'utiliser la fonction de PCPT (sur codyx) qui gère les fichiers cachés (et option filtre, de l'extension) : Function GetFilesPathFromDirectory(ByVal sDir As String, ByRef aRet() As String, Optional ByVal sFilter As String = "*.txt") As Long ' GetFilesPathFromDirectory retourne -1 si aucun fichier trouvé ' sinon retourne la dimension du tableau, donc NB fichiers -1 (tableau commence à l'indice 0) ' init les résultats GetFilesPathFromDirectory = -1 Erase aRet If RightB$(sDir, 2) <> "" Then sDir = sDir & "" ' formate le chemin Dim sFile As String, lIndex As Long sFile = Dir(sDir & sFilter, vbHidden Or vbSystem) ' redimentionne après vérif premier fichier If sFile <> vbNullString Then lIndex = 0 ReDim aRet(lIndex) aRet(lIndex) = sDir & sFile sFile = Dir ' boucle sur tous les fichiers Do While sFile <> vbNullString lIndex = UBound(aRet) + 1 ReDim Preserve aRet(lIndex) aRet(lIndex) = sDir & sFile sFile = Dir Loop ' retour GetFilesPathFromDirectory = lIndex End If End Function ' EXEMPLE D'UTILISATION Private Sub Command1_Click() Dim aResultat() As String Dim lRet As Long Dim i As Long lRet = GetFilesPathFromDirectory("C:\Windows", aResultat()) If lRet <> -1 Then For i = 0 To lRet Debug.Print "Fichier " & i + 1 & " = " & aResultat(i) Next i End If End Sub Coloration syntaxique automatique [mortalino] @++

--Mortalino-- Le mystérieux chevalier, "Provençal, le Gaulois" /DIV>

ushiwasasuke · Answer

Merci bcp pour vos réponses 

Je vais regarder tout ca...

Mais moi qui suis débutant je trouve un peu compliquer d'adapter ce code au mien

mortalino · Answer

Rien de compliquer, c'est l'avantage d'une fonction sortant de Codyx, elle est [presque] toute prête : ' EXEMPLE D'UTILISATION ' ouvre un nouveau projet (projet exe), appuie sur Ctrl + G (fenêtre execution s'affiche) Private Sub Form_Load() Dim aResultat() As String Dim lRet As Long Dim i As Long lRet = GetFilesPathFromDirectory("C:\Windows", aResultat()) ' Tu n'as que C:\Windows à remplacer, par le bon chemin du dossier If lRet <> -1 Then For i = 0 To lRet Debug.Print "Fichier " & i + 1 & " = " & aResultat(i) Next i End If Function GetFilesPathFromDirectory(ByVal sDir As String, ByRef aRet() As String, Optional ByVal sFilter As String = "*.txt") As Long GetFilesPathFromDirectory = -1 Erase aRet If RightB$(sDir, 2) <> "" Then sDir = sDir & "" Dim sFile As String, lIndex As Long sFile = Dir(sDir & sFilter, vbHidden Or vbSystem) If sFile <> vbNullString Then lIndex = 0 ReDim aRet(lIndex) aRet(lIndex) = sDir & sFile sFile = Dir Do While sFile <> vbNullString lIndex = UBound(aRet) + 1 ReDim Preserve aRet(lIndex) aRet(lIndex) = sDir & sFile sFile = Dir Loop GetFilesPathFromDirectory = lIndex End If End Function Colle ces codes, la fonction, il ne faut pas y toucher, les seuls choses à faire sont mis en rouge. Une fois tout cela collé, appuie sur F5 et tu verras le résultat s'afficher dans la fenêtre d'execution. @++

--Mortalino-- Le mystérieux chevalier, "Provençal, le Gaulois" /DIV>

ushiwasasuke · Answer

Donc si je comprend bien je copie tout votre code dans ma fonction

Private Sub btn_lister_Click()

Et ensuite je remplace juste 

lRet
 
= 
GetFilesPathFromDirectory("C:\Windows", 
aResultat())

par

lRet = GetFilesPathFromDirectory(edit_repertoire, aResultat())

C'est bien ca ?

mortalino · Answer

Si edit_repertoire contient le chemin du dossier à lire, oui ! La foncion est à coller après toutes tes procédures (sub) Dans le code suivant : If lRet <> -1 Then For i = 0 To lRet Debug.Print "Fichier " & i + 1 & " = " & aResultat(i) Next i End If lRet contient le nombre total de fichier (d'où son utilisation dans la boucle) aResultat(i) contient le nom du fichier i, i étant de 1 au nombre de total de fichiers (donc lRet). Je t'avais dis d'afficher la fenêtre d'exécution, car debug.print veut dire "insrit dans la fenêtre d'exécution tel résultat", en l'occurence, les noms de ces fichiers. A toi de remplacer le debug.Print par ce que tu veux faire, par exemple, si tu veux placer les données dans une ListBox : If lRet <> -1 Then For i = 0 To lRet List1.AddItem "Fichier " & i + 1 & " = " & aResultat(i) Next i End If bonne prog. @++

--Mortalino-- Le mystérieux chevalier, "Provençal, le Gaulois" /DIV>

mortalino · Answer

Ah et quand je disais "La fonction est à coller après toutes tes procédures (sub)"
par contre tout ce qui dans Form_Load, c'est ce code là que tu dois placer dans l'évènement Click de ton bouton btn_lister

@++ 

<hr width="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
/DIV>

ushiwasasuke · Answer

je récapitule... dans la procédure forme load : Private Sub Form_Load() Dim aResultat() As String Dim lRet As Long Dim i As Long lRet = GetFilesPathFromDirectory("C:\Windows", aResultat()) ' Tu n'as que C:\Windows à remplacer, par le bon chemin du dossier If lRet <> -1 Then For i = 0 To lRet Debug.Print "Fichier " & i + 1 & " = " & aResultat(i) Next i End If Function GetFilesPathFromDirectory(ByVal sDir As String, ByRef aRet() As String, Optional ByVal sFilter As String = "*.txt") As Long GetFilesPathFromDirectory = -1 Erase aRet If RightB$(sDir, 2) <> "" Then sDir = sDir & "" Dim sFile As String, lIndex As Long sFile = Dir(sDir & sFilter, vbHidden Or vbSystem) If sFile <> vbNullString Then lIndex = 0 ReDim aRet(lIndex) aRet(lIndex) = sDir & sFile sFile = Dir Do While sFile <> vbNullString lIndex = UBound(aRet) + 1 ReDim Preserve aRet(lIndex) aRet(lIndex) = sDir & sFile sFile = Dir Loop GetFilesPathFromDirectory = lIndex End If End Function Ensuite dans la procédure btn_lister If lRet <> -1 Then For i = 0 To lRet List1.AddItem "Fichier " & i + 1 & " = " & aResultat(i) Next i End If Ensuite dans la procédure btn_lister Pkoi chez moi la propriété AddItem est inconnue ??? Y'a-t-il une libraire ou un dll à installer ? Je suis sous Access 2000 Merci d'avance.

ushiwasasuke · Answer

Ah oui mais enfait la procédure Forme Load est juste pour rechercher le path c'est bien ca ???

Si oui je n'en ai pas besoin étant donner que je le récupère déjà avec la procédure SelectFolder :

Public Function SelectFolder(Optional Folder As String = "" _
           , Optional NetWorkFolders As NetWork = WithNetworkFolders _
           ) As String
    Dim X As Long, bi As BROWSEINFO, dwIList As Long
    Dim szPath As String, wPos As Integer    If Folder "" Then Folder CurrentProject.Path
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = "Sélectionnez votre dossier et cliquez sur OK"
        .ulFlags = BIF_RETURNONLYFSDIRS _
            Or BIF_USENEWUI _
            Or NetWorkFolders
    End With
    dwIList = SHBrowseForFolder(bi)
    szPath = Folder & Space$(512 - Len(Folder))
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    If X Then
        wPos = InStr(szPath, Chr(0))
        SelectFolder = Left$(szPath, wPos - 1)
    Else
        SelectFolder = ""
    End If
End Function

Problème avec une listbox

11 réponses

Votre réponse

Discussions similaires