Comme dit dans le titre, cette application convertit des fichiers CSV en fichiers XLS
N’est pas nécessaire pour Excel 2007, ce dernier faisant la conversion automatiquement
La conversion n’ayant pas de mise en forme, en cas de modification ultérieure des fichiers XLS ils devront êtres sauvés sous le format de l’Excel employé mais sans aucune difficulté, il suffit de cliquer oui sur le message.
Étant donné que plusieurs sous-fonctions sont reprises dans ce tutoriel, elles sont séparées en paragraphes.








Trois modes de lecture sont disponibles.


*En texte la transcription est littérale.

*En Standard les nombres sont afficher avec les décimales d'origine, format obligatoire s'il y a des données représentant des heures, qui sont transcodées avec des nombres à 6 décimales.

*En numérique ils sont tous avec 3 décimales.
Pour ces deux derniers modes, les formats de cellules tel que les dates doivent êtres reformatées


*Possibilité de convertir un fichier spécifique ou le contenu complet d’un répertoire.

*Possibilité d’enregistrer automatiquement au format XLS.

*Possibilité de supprimer automatiquement les fichiers CSV

Préliminaires

Ouvrir un nouveau classeur et le renommer sous Convertir Csv_xls.xls et y coller un bouton.
Ouvrir l'IDE de VBA (Alt+F11)
Ajouter un Userforme, le renommer csvxls et mettre les contrôles...
Un frame >Caption = Opérations, avec


*1 OptionButton > Name = Un_Seul_Fichier > Value = True

*1 OptionButton > Name = ToutFich > Value = False
Un Frame > caption = Sortie en, avec...


*1 OptionButton > Name = Texte_Num > Value = True

*1 OptionButton > Name = OptNumeric > Value = False

*1 OptionButton > Name = Standard > Value = True

*1 CheckBox > Name = Sauver_XLS > Value = False

*1 CheckBox > Name = Supprimer_CVS > Value = False > Enabled = False

*1 CommandButton > Name = CommandButton1

Code dans Feuil1

Private Sub CommandButton1_Click()
    'En Non Modale, permet de laisser l'userforme afficher et 
    'de naviguer dans le nouveau classeur.
    csvxls.Show 0
End Sub

Code dans le module de l'userform

Private Sub CommandButton1_Click()
    SuppFichier = Supprimer_CVS.Value
    SauveXLS = Sauver_XLS.Value
    
    If Texte_Num.Value Then
        TxtNum = 1
    ElseIf OptNumeric Then
        TxtNum = 2
    Else
        TxtNum = 3
    End If
    
    If Un_Seul_Fichier.Value = True Then
    'Un seul fichier du répertoir
        If SelectionFichier() Then
            ConvertiCvsXls
        End If
    Else
    'Tout un répertoir
        ConvertiRep
    End If
End Sub

Private Sub Sauver_XLS_Click()
    Supprimer_CVS.Enabled = Sauver_XLS
    If Not Sauver_XLS Then
        Supprimer_CVS = False
    End If
End Sub

Code dans Module1

Pour ajouter un module >> Insertion >> Module (c'est la fenêtre Module1)

Code dans l'entête

Option Explicit
Public Chemin As String
Public Fichier As String

Const Ext = "csv"

'Détermine si les fichiers du répertoire seront supprimer
Public SuppFichier As Boolean

'Détermine si sauve en xls
Public SauveXLS As Boolean

'Détermine si tous les fichiers du répertoire seront convertit
Public Tous As Boolean


'Détermine sortie texte/Numérique
Public TxtNum As Integer

Lire tout les fichiers du répertoir spécifié

Sub ConvertiRep()
Dim fs, F, f1, s, sf
Dim i As Long, Fin As Long
'-----------------------------------------------------------
    'Sélectionner le répertoir
    SelectionRep
'-----------------------------------------------------------
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf
        If LCase(Right(f1.Name, 3)) = Ext Then
            Fichier = f1.Name
            ConvertiCvsXls
        End If
    Next
End Sub

Convertir un fichier cvs en xls

Sub ConvertiCvsXls()
Dim TB
Dim Lig As Long, i As Integer, AncNom As String
    AncNom = Fichier
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
    Workbooks.Open Filename:=Chemin & Fichier
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    With ActiveSheet
        Select Case TxtNum
        Case 1
            .Cells.NumberFormat = "@"
        Case 2
            .Cells.NumberFormat = "0.000"
        Case 3
            .Cells.NumberFormat = "General"
        End Select
        For Lig = 1 To Range("A65536").End(xlUp).Row
'Changer la  , (virgule) par le séparateur de votre fichier
            TB = Split(.Cells(Lig, 1), ",")
            For i = 0 To UBound(TB) - 1
                .Cells(Lig, i + 1) = TB(i)
            Next i
        Next Lig
    End With
    If SauveXLS Then
        Fichier = Left(Fichier, Len(Fichier) - 3) & "xls"
        If Dir(Chemin & Fichier) = "" Then
            'le fichier xls n'existe pas encore
            ActiveWorkbook.SaveAs Chemin & Fichier, FileFormat:=xlExcel9795 'Jusqu'au 2000
            Workbooks(Fichier).Close SaveChanges:=False
        Else
            'le fichier xls existe, voir si ont l'écrase sans tomber en erreur.
            If MsgBox("Le fichier " & Fichier & " existe déjà" & Chr(13) _
            & "Faut-il l'écraser ?", vbQuestion + vbYesNo, "Ecraser fichier") = 6 Then
                Application.DisplayAlerts = False
                ActiveWorkbook.SaveAs Chemin & Fichier, FileFormat:=xlExcel9795 'Jusqu'au 2000
                Workbooks(Fichier).Close SaveChanges:=False
                Application.DisplayAlerts = True
            ElseIf Tous Then
                'Eviter la surcharge de classeur si tous les fichiers
                Workbooks(AncNom).Close SaveChanges:=False
            Else
                Application.ScreenUpdating = True
                Application.DisplayAlerts = True
                Exit Sub
            End If
        End If
    End If
    If SuppFichier Then
        'supprime le fichier cvs
        Kill Chemin & AncNom
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Sélectionner le chemin par boite de dialogue

Sub SelectionRep()
Const ssfTous = &H1
Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", ssfTous)
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path
    Set objShell = Nothing
    Set objFolder = Nothing
    Set oFolderItem = Nothing
End Sub

Sélectionner un fichier par boite de dialogue

Function SelectionFichier() As Boolean
Dim nomfich As String, i As Integer
    nomfich = Application.GetOpenFilename(FileFilter:="(*.csv),*.csv" _
            , Title:="Sélectionnez le fichier à convertir")
    If nomfich = "Faux" Then 'pas de sélection faite
        Exit Function
    End If
    For i = Len(nomfich) To 2 Step -1
        If Mid(nomfich, i, 1) = "\" Then Exit For
    Next i
    Chemin = Left(nomfich, i)
    Fichier = Mid(nomfich, i + 1)
    SelectionFichier = True
End Function

Téléchargement

Vous pouvez télécharger le classeur sur Cjoint.com jusqu'au 02/03/2009
Si la date est dépassée vous pouvez m’envoyer un MP et je le remettrais
Le classeur de conversion