Excel - Convertir fichier(s) CSV / XLS

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.
- Préliminaires
- Code dans Feuil1
- Code dans le module de l'userform
- Code dans l'entête
- Lire tout les fichiers du répertoir spécifié
- Convertir un fichier cvs en xls
- Sélectionner le chemin par boite de dialogue
- Sélectionner un fichier par boite de dialogue
- Téléchargement
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
Ce document intitulé « Excel - Convertir fichier(s) CSV / XLS » issu de Comment Ça Marche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.