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.
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
Cet article est régulièrement mis à jour par des experts sous la direction de Jean-François Pillou, fondateur de CommentCaMarche et directeur délégué au développement numérique du groupe Figaro.
