'***************************************************************************************
'* Module : Module ImportExportTxt
'* Author : mromain
'* Date : 10/06/2009
'* Purpose : contient 2 procédures
'* - TxtToXls : importe un fichier texte dans une feuille Excel
'* - XlsToTxt : exporte une feuille Excel dans un fichier texte
'***************************************************************************************
'---------------------------------------------------------------------------------------
' Procedure : Procédure TxtToXls
' Author : mromain
' Date : 10/06/2009
' Purpose : importe un fichier texte dans une feuille Excel
' - l'attribut "sheetDest" représente la feuille de destination (pour l'import)
' - si l'attribut "importFileName" n'est pas précisé, une IHM demandera à l'utilisateur de sélectionner le fichier
' - si l'attribut "csvDelimiter" n'est pas précisé, la valeur prise par défaut sera ";"
'---------------------------------------------------------------------------------------
'
Public Sub TxtToXls(sheetDest As Worksheet, Optional importFileName As String, Optional csvDelimiter As String = ";")
Dim myFso As Object, csvFile As Object, csvLine As String, tabStr() As String, numLigne As Integer, numColonne As Integer
' si le nom de fichier CSV source n'a pas été précisé,
If importFileName = Empty Or Not ((importFileName Like "*" & Dir(importFileName)) And Dir(importFileName) <> vbNullString) Then
' récupérer le nom du fichier CSV à importer
Do
importFileName = Application.GetOpenFilename(filefilter:="Fichier texte à importer, *.*")
Loop Until UCase(importFileName) <> "FAUX"
End If
' ouvrer le fichier CSV
Set myFso = CreateObject("Scripting.FileSystemObject")
Set csvFile = myFso.OpenTextFile(importFileName)
numLigne = 1
' tant qu'on est pas à la fin du fichier CSV
While Not csvFile.AtEndOfStream
' lire la ligne suivante
csvLine = csvFile.ReadLine
' "spliter" la ligne
tabStr = Split(csvLine, csvDelimiter)
' boucler sur chaque élément de la ligne
For numColonne = LBound(tabStr) + 1 To UBound(tabStr) + 1
' reporter la valeur de l'élément sur la feuille
sheetDest.Cells(numLigne, numColonne).Value = tabStr(numColonne - 1)
Next numColonne
' se décaler d'une ligne
numLigne = numLigne + 1
Wend
' fermer le fichier
csvFile.Close
Set csvFile = Nothing: Set myFso = Nothing
End Sub
'---------------------------------------------------------------------------------------
' Procedure : Procédure XlsToTxt
' Author : mromain
' Date : 10/06/2009
' Purpose : exporte une feuille Excel dans un fichier texte
' - l'attribut "sheetExport" représente la feuille source (pour l'export)
' - si l'attribut "exportFileName" n'est pas précisé, une IHM demandera à l'utilisateur de sélectionner le fichier
' - si l'attribut "csvDelimiter" n'est pas précisé, la valeur prise par défaut sera ";"
'---------------------------------------------------------------------------------------
'
Public Sub XlsToTxt(sheetExport As Worksheet, Optional exportFileName As String, Optional csvDelimiter As String = ";")
Dim myFso As Object, csvFile As Object, i As Integer, j As Integer, csvLine As String
' si le nom de fichier CSV destination n'a pas été précisé,
If exportFileName = Empty Then
' récupérer le nom du fichier à créer
Do
exportFileName = Application.GetSaveAsFilename(InitialFileName:=sheetExport.Name & ".csv", filefilter:="Fichier CSV, *.csv")
Loop Until UCase(exportFileName) <> "FAUX"
End If
' créer le fichier
Set myFso = CreateObject("Scripting.FileSystemObject")
Set csvFile = myFso.CreateTextFile(Filename:=exportFileName, overwrite:=True)
With sheetExport
' boucler sur toutes les lignes
For i = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Row
' initialiser la ligne CSV
csvLine = vbNullString
' boucler sur toutes les colonnes
For j = 1 To .Cells.SpecialCells(xlCellTypeLastCell).Column
' créer la ligne
csvLine = csvLine & .Cells(i, j).Text & csvDelimiter
Next j
csvLine = Left(csvLine, Len(csvLine) - Len(csvDelimiter))
' écrire la ligne dans le fichier
csvFile.WriteLine csvLine
Next i
End With
' fermer le fichier
csvFile.Close
Set csvFile = Nothing: Set myFso = Nothing
End Sub
