Les fichiers (Excel ou autres)

Page mise à jour le : 10/02/2002

Vous trouverez dans cette rubrique des exemples de programmes se rapportant aux traitement sur des fichiers Excel ou autres (txt, ini, log).

Ecrire dans un fichier de type texte (Date, heure) à l'ouverture ou la fermeture d'Excel.
Lire et incrémenter un fichier INI.
Lire les enregistrements dans un fichier texte.
Lister des fichiers texte et les ouvrir avec GetOpenFileName.
Lister tous les fichiers XLS dans une feuille de calcul.
Réaliser une copie du classeur actif sous un autre nom.
Récupérer le nom d'un fichier sélectionné par GetOpenFileName.


 
Ecrire dans un fichier de type texte (date et heure).Retour au début

 
Ce programme utilise les événements WorkBook_Open et  Workbook_BeforeClose pour inscrire
des informations dans un fichier de type texte lors de l'ouverture et de la fermeture d'Excel.
Dans l'exemple, le fichier texte se nomme activite.log

Private Sub Workbook_Open()
      Dim LogFile As String
      LogFile = "C:\Excel\activite.log"
      ChDir "C:\Excel"
      Donnees = Now()
      Open LogFile For Append Shared As #1
      Print #1, "Ouverture d'Excel a " & Donnees
      Close #1
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
      Dim LogFile As String
      LogFile = "C:\Excel\activite.log"
      ChDir "C:\Excel"
      Donnees = Now()
      Open LogFile For Append Shared As #1
      Print #1, "Fermeture d'Excel a " & Donnees
      Print #1, "----------------------------------"
      Close #1
End Sub

      Exemple de fichier généré

Lire et incrémenter un fichier INIRetour au début

 
Ce programme permet d'incrémenter un fichier increm.ini et de récupérer
la valeur contenue dans ce fichier. Arrivé à 1000, le compteur est réinitialisé à 1.

Structure du fichier increm.ini
[Numero]
NUMERO=4

Ne pas oublier de copier les deux lignes qui suivent en tête de votre module.

Declare Function GetPrivateProfileStringA Lib "Kernel32" (ByVal lpAppName As _
String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString _
As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Declare Function WritePrivateProfileStringA Lib "Kernel32" (ByVal lpAppName _
As String, ByVal lpKeyName As String, ByVal lpString As String, _
ByVal lpFileName As String) As Long

Sub IncrémenteIni()
Dim Compteur As String * 10
GetPrivateProfileStringA "Numero", "NUMERO", 1, Compteur, 10, "C:\Windows\Increm.ini"
WritePrivateProfileStringA "Numero", "NUMERO", CStr(CLng(Compteur) + 1), _
      "C:\Windows\Increm.ini"
MsgBox "Le compteur est incrémenté à : " & Compteur & "."
If Compteur = 1000 Then
      MsgBox (" La valeur de 1000 est atteinte. Remise à 1 du compteur.")
      Compteur = 1
WritePrivateProfileStringA "Numero", "NUMERO", CStr(CLng(Compteur)), _
      "C:\Windows\Increm.ini"
End If
End Sub


Lire les enregistrements dans un fichier texteRetour au début

 
Ce programme lit les différents enregistrements dans un fichier texte et les inscrits
dans une feuille de calcul.

Structure du fichier Listing.txt
Jordan,Durand,15
Eric,Bataille,52
Marcel,Dupond,35

Sub LireFichierTexte()
Dim Prenom, Nom, Age
' Ouvre le fichier en lecture
Open "C:\Excel\Listing.txt" For Input As #1
' Effectue la boucle jusqu'à la fin du fichier
Do While Not EOF(1)
' Lit les données dans trois variables
Input #1, Prenom, Nom, Age
' Ecrit les données dans la feuille de calcul à partir de la ligne 2
Range("A65536").End(xlUp)(2).Value = Prenom
Range("B65536").End(xlUp)(2).Value = Nom
Range("C65536").End(xlUp)(2).Value = Age
Loop
' Ferme le fichier
Close #1
End Sub


Le résultat

Lister des fichiers texte et les ouvrir avec GetOpenFileNameRetour au début

 
GetOpenFileName:
       Affiche la boîte de dialogue standard Ouvrir et lit un nom de fichier tapé ou sélectionné par l'utilisateur
       sans réellement ouvrir les fichiers.

Sub ChoixFichierTexteAOuvrir()
      ChDir "C:\"
      ChDir "c:\Excel"
      CeFichier =Application.GetOpenFilename("Text Files (*.txt), *.txt")
      If VarType(CeFichier) = vbBoolean Then
            Exit Sub
      Else
            Workbooks.OpenText Filename:=CeFichier, Origin:=xlWindows, _
                  StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                  ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, _
                  Space:=False, Other:=False, FieldInfo:=Array(1, 1)
      End If
End Sub

Lister tous les fichiers XLS dans une feuille de calculRetour au début

 
Ce programme permet de rechercher tous les fichiers Excel du répertoire Excel, de
les placer dans un tableau et de copier ce tableau dans une feuille de calcul.
Sub RechercheClasseursSurDisque()
Dim Classeurs() As String, I As Long
With Application.FileSearch
      .NewSearch
      .FileType = msoFileTypeExcelWorkbooks
      .LookIn = "C:\Excel\"
      .SearchSubFolders = True
      .Execute
With .FoundFiles
      ReDim Classeurs(1 To .Count, 1 To 1)
      For I = 1 To .Count
            Classeurs(I, 1) = .Item(I)
      Next I
Application.ScreenUpdating = False
With Range("A1").Resize(.Count)
      .Value = Classeurs
      .Sort [A1]
End With
End With
End With
End Sub

Réaliser une copie du classeur actif sous un autre nomRetour au début

 
Ce programme enregistre le classeur actif sous un autre nom (une copie) sans
pour autant modifier le nom du classeur actif.

Sub SaveCopyAs()
      ActiveWorkbook.SaveCopyAs "C:\excel\Double.xls"
End Sub

Récupérer le nom d'un fichier sélectionné par GetOpenFileNameRetour au début

 
Cas d'utilisation
Par exemple si vous faites une lecture/écriture (via Open FileName For Input As #1) d'un
fichier sélectionné par GetOpenFilename pour inscrire les enregistrements dans un nouveau
classeur (via Workbooks.Add template:=xlWorksheet), vous n'avez à aucun moment réellement
ouvert ce fichier mais vous voulez en connaître le nom pour le donner à votre classeur actif.

Public NameSansExtension As String
Sub SelectionFichier()
      Dim LongFilename As String
      LongFilename = Application.GetOpenFilename("Text Files (*.txt), *.txt")
      ShortFilename (LongFilename)
      MsgBox "Le nom sans extension du fichier est : " & NameSansExtension
End Sub

Function ShortFilename(LongFilename As String) As String
       For i = Len(LongFilename) To 1 Step -1
            If Mid(LongFilename, i, 1) = "\" Then Exit For
      Next
      ShortFilename = Mid(LongFilename, i + 1, Len(LongFilename))
      NameSansExtension = Mid(ShortFilename, 1, Len(ShortFilename) - 4)
End Function