XLSX ->CSV -> XLSX sans perdre les formules
Bonjour à tous,
Je travaille sur un fichier XLSX qui contient des formules. Je dois faire subir un traitement à ce fichier (ajout de lignes) mais ne peut le faire que s'il est au format CSV. Toutefois, je ne veux pas perdre les formules.
1. Je voudrais pouvoir enregistrer ce fichier en CSV avec les formules plutôt que les valeurs. Est-ce possible ?
2. Ensuite, je voudrais pouvoir convertir mon CSV en XLSX de sorte à ce qu'il retrouve sa forme initiale (formules calculants les valeurs). Est-ce également possible ?
Merci d'avance pour votre aide !
Bonjour Anita,
Une proposition :
_exporter la feuille qui contient les formules en un csv, supprimer la feuille concernée mais garder le fichier xlsx (pour éviter de récrire les macros à chaque opérations...
_importer ensuite le csv traité a volonté
Les seules données à adapter sont les constantes vPth$ et vShNm$ en tête de module (chemin pour l'export/import et nom de la feuille)
Ca à l'air de fonctionner chez moi mais peut-être faudrait-il connaitre la nature des formules ?
A tester donc.
Lancer la sub XlsToCsv pour l'export et CsvToXls pour l'import
Cordialement
Jules
Option Explicit
Const vPth$ = "C:\Documents and Settings\Nom\Mes documents\forums\Anita_csvFormule\"
Const vShNm$ = "Feuil1"
Sub XlsToCsv()
'exporte la feuille vShNm dans le dossier vPth, supprimer la feuille d'origine
Call XlsToCsvFor(vShNm, True, vPth)
End Sub
Sub CsvToXls()
'importe le csv situé dans le dossier vPth et nommé vShNm (nom sans extension)
Call CsvToXlsFor(vShNm, vPth)
End Sub
Private Sub XlsToCsvFor(vSFN As String, b As Boolean, sPth As String)
'entrées: nom de la feuille, delete de la feuille ?, chemin du dossier (avec \ final) pour le csv
Dim x$, i&, j%, Cl%, Rw&, n%
n = FreeFile
Rw = Worksheets(vSFN).UsedRange.Rows.Count
Cl = Worksheets(vSFN).UsedRange.Columns.Count
Open sPth & vSFN & ".csv" For Output As #n
For i = 1 To Rw
x = ""
For j = 1 To Cl
x = x & Worksheets(vSFN).Cells(i, j).Formula & ";"
Next j
Print #n, x
Next i
Close #n
If b = True And Worksheets.Count > 1 Then
Application.DisplayAlerts = False
Worksheets(vSFN).Delete
Application.DisplayAlerts = True
End If
End Sub
Private Sub CsvToXlsFor(vSFN As String, sPth As String)
'entrées: nom du fichier (sans extansion), chemin du dossier (avec \ final) du csv
Dim b%, i%
Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPth & vSFN & ".csv", Destination:=Range("$A$1"))
.AdjustColumnWidth = True
.TextFileParseType = xlDelimited
.TextFileSemicolonDelimiter = True
.Refresh BackgroundQuery:=False
End With
For i = 1 To Worksheets.Count
If Worksheets(i).Name = vSFN Then
b = True
Exit For
End If
Next i
If b = False Then ActiveSheet.Name = vSFN
End SubMerci de ta réponse détaillée Jules !
Je suis vraiment débutante en Excel, mais je vais voir si je peux m'en sortir avec tes explications.
Si jamais tu voulais voir mes formules, elles sont dans le fichier que j'attache ici :
Bonsoir Anita,
La solution du précédent post ne marchait pas car d'une part Excel transforme en anglais les formules et surtout parce que je n'avais pas pensé aux décalages des références dans les formules.
Donc ci-joint un fichier avec une autre approche.
Le principe :
On exporte en csv (macro XlsToCsv) les colonnes ne contenant pas de formules et on garde dans le fichier Excel que les deux premières lignes (ligne de titre et première ligne contenant des formules).
A l'import (macro CsvToXls) on réimporte les colonnes et on copie les formules restantes sur les colonnes concernées.
Mode d'emploi :
adapter cette ligne à ton chemin :
Const vPth$ = "C:\Documents and Settings\test\"
et éventuellement celle ci si le nom de la feuille à exporter change :
Const vShNm$ = "DP"
Option Explicit
Const vPth$ = "C:\Documents and Settings\test\"
Const vShNm$ = "DP"
Sub XlsToCsv()
'exporte la feuille vShNm dans le dossier vPth, supprimer la feuille d'origine
Call XlsToCsv2(vShNm, vPth)
End Sub
Sub CsvToXls()
'importe le csv situé dans le dossier vPth et nommé vShNm (nom sans extension)
Call CsvToXls2(vShNm, vPth)
End Sub
Private Sub XlsToCsv2(vSFN As String, sPth As String)
'entrées: nom de la feuille, chemin du dossier (avec \ final) pour le csv
Dim x$, i&, j%, Cl%, Rw&, n%, tb%()
n = FreeFile 'n° libre de fichier
Rw = Worksheets(vSFN).UsedRange.Rows.Count 'n° dernière ligne
Cl = Worksheets(vSFN).UsedRange.Columns.Count 'n° derniere colonne
ReDim tb(1 To Cl) 'tableau contenant Cl éléments
For i = 1 To Cl 'pour chaque colonne
'si la cellule de la ligne 2 commence par le signe égal, l'élément du tableau prend la valeur 1
If Left(Worksheets(vSFN).Cells(2, i).Formula, 1) = "=" Then tb(i) = 1
Next i
Open sPth & vSFN & ".csv" For Output As #n 'ouverture/création d'un fichier csv portant le nom de la feuille
For i = 1 To Rw 'pour chaque ligne
x = "" 'ce qu'on va écrire
For j = 1 To Cl 'pour chaque colonne
If tb(j) = 1 Then 'si l'élément du tableau correspondant à la colonne vaut 1 alors
x = x & ";" 'on écrit que le séparateur à la suite de x
Else 'sinon
x = x & Worksheets(vSFN).Cells(i, j) & ";" 'on écrit à la suite de x la valeur de la cellule et le séparateur
End If
Next j
Print #n, x 'on écrit x dans le fichier
Next i
Close #n 'fermeture du fichier
'suppression de toutes les lignes inutiles si le tableau à au moins 3 lignes
If Rw > 2 Then
Worksheets(vSFN).Range(Worksheets(vSFN).Cells(3, 1), Worksheets(vSFN).Cells(Rw, 1)).EntireRow.Delete
End If
End Sub
Private Sub CsvToXls2(vSFN As String, sPth As String)
'entrées: nom de la feuille, chemin du dossier (avec \ final) pour le csv
Dim i%, Cl%, Rw&, Ws As Worksheet, tb%()
Sheets.Add After:=Sheets(Sheets.Count) 'ajout d'une feuille (temporaire)
'importation du fichier csv
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPth & vSFN & ".csv", Destination:=Range("$A$1"))
.TextFileParseType = xlDelimited ' le fichier est de type délimité par un séparateur
.TextFileSemicolonDelimiter = True 'le séparateur est le point-virgule
.Refresh BackgroundQuery:=False 'ne pas rafraichir la requête
End With
Set Ws = Worksheets(vSFN) 'déclaration de la feuille à actualiser (DP)
Cl = Ws.UsedRange.Columns.Count
ReDim tb(1 To Cl)
For i = 1 To Cl
If Left(Ws.Cells(2, i).Formula, 1) = "=" Then tb(i) = 1
Next i
Rw = ActiveSheet.UsedRange.Rows.Count
For i = 1 To Cl
If tb(i) = 0 Then 'si l'élément du tableau vaut 0 copier la colonne de la nouvelle feuille vers DP
ActiveSheet.Range(ActiveSheet.Cells(2, i), ActiveSheet.Cells(Rw, i)).Copy _
Destination:=Ws.Cells(2, i)
Else 'sinon prendre la formule en ligne 2 et la copier sur la hauteur idoine
Ws.Cells(2, i).Copy Destination:=Ws.Range(Ws.Cells(2, i), Ws.Cells(Rw, i))
End If
Next i
Application.DisplayAlerts = False 'désactive les alertes
ActiveSheet.Delete 'suppression de la feuille temporaire
Application.DisplayAlerts = True
End Sub