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 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
| Dim FSO As New Scripting.FileSystemObject
Dim FSO1 As New Scripting.FileSystemObject
Dim Repertoire As Scripting.Folder
Dim Repertoires As Scripting.Folders
Dim Fichier As Scripting.File
Dim Fichiers As Scripting.Files
Dim NomFichierCourant As String
Dim ValTest As Integer 'Valeur de test
Private Sub ListBox1_Click()
End Sub
Private Sub ChangeRepertoire_Click()
FileSystem.ChDir ("..") 'Remonte au répertoire parent
AfficheFichiers (FileSystem.CurDir$)
End Sub
Private Sub CommandButton1_Click()
AfficheFichiers (FileSystem.CurDir$)
End Sub
Private Sub CommandButton2_Click()
End Sub
Private Sub FichierOuvrir_Click()
Dim Xapp As New Excel.Application
Dim Classeur As Excel.Workbook
Dim X As Double
Dim Num, Typ, Test As String
Dim Code_Test As Long
Set Classeur = Xapp.Workbooks.Open(NomFichierCourant)
AfficheNumero.ListeNumero.Clear
For X = 3 To 16
Num = Classeur.Worksheets(1).Rows(X).Cells(2).Text
Typ = Classeur.Worksheets(1).Rows(X).Cells(3).Text
Test = Classeur.Worksheets(1).Rows(X).Cells(14).Text
If Test <> "" Then Code_Test = Val(Test) Else Code_Test = 0
With AfficheNumero.ListeNumero
.AddItem Num
.List(.ListCount - 1, 1) = Typ
End With
With AfficheNumero.ListCodeTest
.AddItem Code_Test
End With
Next
'Classeur.Application.SendKeys ("+{F4}")
'Classeur.Application.Quit
'Classeur.Save
Xapp.Quit
Set Xapp = Nothing
Set Classeur = Nothing
UserForm1.Hide
AfficheNumero.Show
End Sub
Private Sub ListeFichier_Click()
a = ListeFichier.ListIndex
NomChemin.Text = ListeChemin.List(a)
NomFichierCourant = ListeChemin.List(a)
End Sub
Private Sub ListeRepertoire_Click()
FileSystem.ChDir (ListeRepertoire.List(ListeRepertoire.ListIndex))
AfficheFichiers (FileSystem.CurDir$)
End Sub
Private Sub UserForm_Click()
End Sub
Public Sub AfficheFichiers(ByVal Chemin As String)
'Dim Chemin As String
Dim f As File
Dim fd As Folder
'Chemin = FileSystem.CurDir$
Set Repertoire = FSO.GetFolder(Chemin)
ListeFichier.Clear
ListeChemin.Clear
ListeRepertoire.Clear
'Affiche les noms des Sous Répertoires
For Each fd In Repertoire.SubFolders
ListeRepertoire.AddItem (fd.Name)
Next
'Affiche les noms des fichiers
For Each f In Repertoire.Files
If Right(f.Name, 4) = ".xls" Then
ListeFichier.AddItem (f.Name)
ListeChemin.AddItem (f.Path)
End If
Next
End Sub
Private Sub UserForm_Initialize()
ValTest = 5
End Sub |
Partager