ExportCSV()

manu cho

XLDnaute Nouveau
Bonjour le forum,


J'ai un double problème ...
Deux macros qui me permettent d'enregistrer les feuilles de mon classeur au format CSV.

La première :

Sub ExportCSV()
' Export le contenu d'une feuille au format CSV et l'enregistre automatiquement dans le folder ou est stocké le fichier XLS.
Dim objF As Worksheet
Dim lngCellules As Long
Dim lngColonnes As Long
Dim i As Long
Dim R As Range
Dim j As Long
Dim fCond As FormatCondition
Dim strCSV As String
Dim sPath As String

Set objF = Excel.Active.Sheet

sPath = ThisWorkbook.Path & "\" & objF.Name & ".csv"

lngColonnes = objF.UsedRange.Columns.Count
lngCellules = objF.UsedRange.Rows.Count

For i = 1 To lngCellules
For j = 1 To lngColonnes
Set R = objF.Cells(i, j)
If R.NumberFormat = "@" Then
strCSV = strCSV & Chr(34) & R.Value & _
Chr(34) & IIf(j < lngColonnes, ";", "")
Else
strCSV = strCSV & IIf(R.NumberFormat <> _
"General", Format(R.Value, R.NumberFormat), _
R.Value) & IIf(j < lngColonnes, ";", "")
End If
Next
strCSV = strCSV & IIf(i < lngCellules, vbCrLf, "")
Next

If Len(strCSV) > 0 Then
Open sPath For Output As #1
Print #1, strCSV
Close #1
MsgBox "L'exportation c'est bien déroulé"
Else
MsgBox "Il n'y a aucune donnée dans la feuille active"
End If

Set R = Nothing
Set fCond = Nothing
Set objF = Nothing

End Sub


Fonctionne habituellement bien, mais depuis peu me renvoit l'erreur suivante : Erreur d'éxecution "6", dépassement de capacité.

En regardant le débug, il y a effectivement un problème sur la ligne :
strCSV = strCSV & IIf(R.NumberFormat <> "General", Format(R.Value, R.NumberFormat), R.Value) & IIf(j < lngColonnes, ";", "")

ou R.Value est égal à 10726201.

Une idée?




La deuxième macro fonctionne différement, j'obtiens à l'éxecution une erreur "0"... :

Sub ExportCSV2()
' Export le contenu de toutes les feuilles au format CSV et l'enregistre automatiquement feuille par feuille dans le folder ou est stocké le fichier XLS.

Dim Mafeuille As Worksheet
Dim MaPlage As Range, UneLigne As Range, UneCellule As Range
Dim StrTemp, sPath As String
Dim Separateur As String

On Error GoTo TraitementErreur

For Each Mafeuille In ActiveWorkbook.Worksheets

Set MaPlage = Mafeuille.UsedRange
sPath = ThisWorkbook.Path
Separateur = ";"


Open sPath & "\" & Mafeuille.Name & ".csv" For Output As #1
For Each UneLigne In MaPlage.Rows
StrTemp = ""
For Each UneCellule In UneLigne.Cells
StrTemp = StrTemp & CStr(UneCellule.Text) & Separateur
Next
Print #1, StrTemp
Next
Close
Next

TraitementErreur:

MsgBox Err.Description, vbExclamation, "Erreur n°" & Err.Number, Err.HelpFile, Err.HelpContext

End Sub


Les fichiers CSV sont bien enregistrés pourtant, mais dans le XLSTART ...

Help ! :)

Bonne journée,
Manu.
 

wilfried_42

XLDnaute Barbatruc
Re : ExportCSV()

Bonjour

Je ne sais pas si ta 2eme macro et là complete mais si c'est le cas, c'est normal :D

Tu as un controle d'erreur, et meme s'il n'y en a pas, la structure de la macro fait que tu y passes

Code:
Print #1, StrTemp
Next
Close
Next
[COLOR="Red"]Exit Sub[/COLOR]
TraitementErreur:



Edit : Attention : si j'ai bien lu ta macro, tu devrais avoir un ; à la fin de chaque ligne, je ne sais pas si ca va gener à la recup, mais regarde quand meme
 
Dernière édition:

manu cho

XLDnaute Nouveau
Re : ExportCSV()

oh suis con, la macro 2 fonctionne nickel ! :)

merci wilfried_42 !

J'ai modifié la 2, qui me permet d'obtenir le même résultat qu'en 1, c'est à dire avec le saut de 3 feuilles spécifiques + un msgbox indiquant que tout est fini.

Ci-dessous le code, si jamais cela peut servir à d'autres!

A+++


Sub ExportCSV2()
' Export le contenu de toutes les feuilles au format CSV et l'enregistre automatiquement feuille par feuille dans le folder ou est stocké le fichier XLS.

Dim Mafeuille As Worksheet
Dim MaPlage As Range, UneLigne As Range, UneCellule As Range
Dim StrTemp, sPath As String
Dim Separateur As String

On Error GoTo TraitementErreur

For Each Mafeuille In ActiveWorkbook.Worksheets
If (Mafeuille.Name <> "General") And (Mafeuille.Name <> "List") And (Mafeuille.Name <> "Exemple") Then

Set MaPlage = Mafeuille.UsedRange
sPath = ThisWorkbook.Path
Separateur = ";"
Open sPath & "\" & Mafeuille.Name & ".csv" For Output As #1
For Each UneLigne In MaPlage.Rows
StrTemp = ""
For Each UneCellule In UneLigne.Cells
StrTemp = StrTemp & CStr(UneCellule.Text) & Separateur
Next
Print #1, StrTemp
Next
Close
End If
Next

MsgBox "L'exportation des données s'est déroulée avec succès"

Exit Sub

TraitementErreur:

MsgBox Err.Description, vbExclamation, "Erreur n°" & Err.Number, Err.HelpFile, Err.HelpContext


End Sub


Et merci pour tout.

PS : no soucy pour le ; , mais je vais poser la question tout de meme. merci!
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
303

Membres actuellement en ligne

Statistiques des forums

Discussions
312 493
Messages
2 088 956
Membres
103 990
dernier inscrit
lamiadebz