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)   
                .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

ATTENTION : dans la Sub ConvertiCvsXls il faut faire une modification,
Enlever le -1 sur la ligne
For i = 0 To UBound(TB) (-1)
Serveur 1 : Convertir CSV XLS.xls