Les fichiers (Excel ou autres)

Page mise à jour le : 24/02/2006

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

Enregistrer un même fichier avec un Nº d'indice : File-v1, File-v2, etc ....
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.


 
Enregistrer un même fichier avec un Nº d'indice : File-v1, File-v2.Retour au début

      Pourquoi ce programme ?

      C'est suite à un besoin professionnel que j'ai réalisé ce programme.
      Depuis un programme, je génère régulièrement un fichier qui porte toujours le même nom (Synthèse carnet.xls)
      Afin de ne pas écraser le fichier généré précédement, je dois indicer le nom du fichier crée.
      Le nom de ce fichier est donc complété avec un symbole Vx où x est un
      nombre qui s'incrémente de manière automatique.
      Exemple :
            Synthèse carnet-v1.xls
      Le principe :
      Avant d'enregistrer le fichier, le programme recherche dans le répertoire de travail combien
      d'occurrences il trouve pour le nom de fichier Synthèse carnet.xls.
      Pour cela on récupère le nom court : Ex: Synthèse carnet
      - Si dans le répertoire il y a par exemple les 3 fichiers suivants :
            • Synthèse carnet.xls
            • Synthèse carnet-v1.xls
            • Synthèse carnet-v2.xls
      Le nombre d'occurrences de Synthèse carnet est 3, donc le programme prendra l'indice 3 et
      nommera le fichier à enregistrer avec le nom Synthèse carnet-v3.xls

 

Public NameSansExtension As String

Public ThisName As String

Public Chemin As String

Public NoIndice As Integer

Sub Execution()

  ThisName = ""

  NoIndice = 0

  Mydate = Format ( Now (), "dd-mm-yy" )

  Chemin = ActiveWorkbook.Path

  Workbooks.Add

  Shortfilename (Chemin & "\Synthèse carnet" & "-" & Mydate & ".xls" )

  ' **********************************************

  ' Ici votre code pour le classeur à traiter ...

  Range( "A1" ).Select

  ActiveCell.FormulaR1C1 = "Je saisis mes données."

  ' **********************************************

  Call RechercheFichiersPourIndice

  ActiveWorkbook.SaveAs Filename:= _

      Chemin & "\" & NameSansExtension & "-v" & NoIndice & ".xls" , _

      FileFormat:=xlNormal, Password:= "" , WriteResPassword:= "" , ReadOnlyRecommended:= False

  ActiveWorkbook.Close savechanges:= False

End Sub

Sub RechercheFichiersPourIndice()

  Dim Shortfilename As String

  Shortfilename = ThisName

  With Application.FileSearch

    .Filename = NameSansExtension

    .FileType = msoFileTypeExcelWorkbooks

    .LookIn = Chemin

    .SearchSubFolders = True

    .Execute

    With .FoundFiles

      NoIndice = .Count

    End With

  End With

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

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


Free counter and web stats