Ecrire dans un fichier .csv ou .txt à partir d'excel

Version imprimable

28/02/2007, 14h26
Beamish

Ecrire dans un fichier .csv ou .txt à partir d'excel

Bonjour à tous,

j'ai un petit problème liée à la limitation à 65xxxx lignes d'excel.

Je m'explique, j'ai un petit prog en vba excel qui me permet d'importer et de réorganiser des données (d'un autre fichier) sous excel.
Mon problème est donc que le fichier originel est censé contenir juste 1 commune hors chez moi il contient près d'1 département (plus de 300 communes !!) d'ou le probleme de limitation d'excel.

donc je souhaiterais ajouter une ligne de code permettant non plus de renseigner directement excel mais un fichier txt ou csv.

l'intérêt étant de conserver le programme tout en ne limitant pas le nombre d'enregistrement à ajouter

Merci beaucoup pour le coup de main !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
'déclaration du fichier
dim fic as string
fic = "C:\Test.txt"
 
'ouverture du fichier
open fic for output as 1
 
'ecirutre dans le fichier
print #1, données à écrire
 
'Fermeture du fichier
close #1
 
End sub

Donc tu as des données dans une feuille Excel et tu souhaites les exporter dans un csv
Combien de colonnes as-tu ? Si tu en as plusieurs, quel séparateur veux-tu
Je te passe un code qui te permet de séparer les données d'une ligne Excel comportant plusieurs colonnes par un séparateur ";" et donc ton fichier sera aussi bien un txt qu'un csv
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub FichierTxt() Dim i, j, DernièreLigne, DernièreColonne, f as worksheet Set f = ActiveSheet DerniereLigne = f.Range("A1").SpecialCells(xlCellTypeLastCell).Row DerniereColonne = f.Range("A1").SpecialCells(xlCellTypeLastCell).Column Open "D:\txt\LeFichier.csv" For Output As #1 For i = 1 To DerniereLigne For j = 1 To DerniereColonne - 1 Print #1, f.Cells(i, j).Formula + ";"; 'pour séparateur ";" tu remplaces si ton séparateur est une virgule Next j Print #1, f.Cells(i, j + 1).Formula Next i Close #1 End Sub
A+

voici mon code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
Sub importFANTOIR()
 
Set Monclasseur = ThisWorkbook
Monclasseur.Activate
 
' Import du fichier FANTOIR
 
ChDir "H:\temp" ' Emplacement du fichier source
ChDrive "H:"
monfichier = Application.GetOpenFilename
If monfichier <> False Then
    rep = MsgBox("Ouvrir : " & monfichier, vbOKCancel)
End If
If rep = 1 Then
' recompose le nom à l'envers pour détecter le premier \
   toto = Len(Trim(monfichier))
   montest = ""
   titi = Trim(monfichier)
   Do
   titi = Right(titi, 1)
       If titi = "\" Then
        ' recompose le mot à l'endroit
         toto = Len(montest)
         titi = montest
         Do
           titi = Right(titi, 1)
           p = p + 1
           Monfic = Monfic + titi
           titi = Mid(montest, 1, toto - p)
           If p = i Then Exit Do
         Loop
         Exit Do
        Else
           i = i + 1
           montest = montest + titi
           titi = Mid(Trim(monfichier), 1, toto - i)
       End If
    Loop
 
If UCase(Left(Monfic, 4)) = "FANR" Then
 
Application.Cursor = xlWait
Application.DisplayStatusBar = True
Application.StatusBar = "Import du fichier Identifiant du Local en cours ..."
 
Application.ScreenUpdating = False
 
Dim maligne As String
' longueur  de l'enregistrement total
Dim mazone(150) As String
 
' Ouvre le fichier en lecture.
Open monfichier For Input As #1
Direction = False
 
' Liste des rues
Sheets("Fantoir").Select
Range("A2:AZ60000").Clear
Set MaParcelle = Range("A2")
 
Do While Not EOF(1)
    ' Ne lit que les chaînes de caractères ne retourne pas
    ' les codes CHr(13)
    Input #1, maligne '
 
 
' En tête commun à tous les articles
 
mazone(1) = Mid(Trim(maligne), 1, 2) 'ccodep
mazone(2) = Mid(Trim(maligne), 3, 1) 'ccodir
mazone(3) = Mid(Trim(maligne), 4, 3)  'ccocom
 
'If mazone(3) = "066" Then 'Selectionne la communne (66 = CHATELLERAULT)
 
If Len(Trim(Mid(Trim(maligne), 74, 1))) = 0 Then 'supprime les entités annulées "O" et "Q" en (74,1)
 
mazone(4) = "'" + Mid(Trim(maligne), 7, 4) 'ccoriv (Impose une zone texte)
mazone(5) = Mid(Trim(maligne), 11, 1) 'cleriv
mazone(6) = Mid(Trim(maligne), 12, 4) 'natvoi
mazone(7) = Mid(Trim(maligne), 16, 26) 'libvoi
mazone(8) = Mid(Trim(maligne), 42, 1) 'filler
mazone(9) = Mid(Trim(maligne), 43, 1) 'typcom
mazone(10) = Mid(Trim(maligne), 44, 2) 'filler
mazone(11) = Mid(Trim(maligne), 46, 1) 'ruractu
mazone(12) = Mid(Trim(maligne), 47, 2) 'filler
mazone(13) = Mid(Trim(maligne), 49, 1) 'carvoi
mazone(14) = Mid(Trim(maligne), 50, 1) 'indpop
mazone(15) = Mid(Trim(maligne), 51, 2) 'filler
mazone(16) = Mid(Trim(maligne), 53, 7) 'popreel
mazone(17) = Mid(Trim(maligne), 60, 7) 'poppart
mazone(18) = Mid(Trim(maligne), 67, 7) 'popfict
mazone(19) = Mid(Trim(maligne), 74, 1) 'annul
mazone(20) = Mid(Trim(maligne), 75, 4) 'janannul
mazone(21) = Mid(Trim(maligne), 82, 4) 'jancrea
mazone(22) = Mid(Trim(maligne), 89, 15) 'filler
mazone(23) = Mid(Trim(maligne), 104, 5) 'ccovoi
mazone(24) = Mid(Trim(maligne), 109, 1) 'indclvoi
mazone(25) = Mid(Trim(maligne), 110, 1) 'indldnb
mazone(26) = Mid(Trim(maligne), 111, 2) 'filler
mazone(27) = Mid(Trim(maligne), 113, 8) 'motclass (permet de restituer l'ordre alphabétique)
mazone(28) = Mid(Trim(maligne), 121, 30) 'filler
 
 
Monclasseur.Sheets("Fantoir").Select
MaParcelle.Select
 
 
 For i = 1 To 28
       Selection.Offset(0, i - 1).Formula = mazone(i)
 Next
 
Set MaParcelle = MaParcelle.Offset(1, 0)
 
End If
 
'End If
 
Loop
Close #1    ' Ferme le fichier.' fin d'import
 
MsgBox "L'import est terminé !"
 
Call Majecran
 
Else
    rep = MsgBox("Le fichier d'import doit être FANR.* !", vbCritical)
    rep = MsgBox("L'import est annulé !", vbCritical)
End If
 
Else
     rep = MsgBox("L'import est annulé !", vbCritical)
End If
Call Majecran
End Sub
 
Sub Majecran()
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = True
'redonne la main à Excel sur la barre des tâches
Application.Cursor = xlDefault
End Sub

j'ai du mal a identifier l'endroit ou inserer ce code...

28/02/2007, 14h49
Beamish

Citation:

Envoyé par ouskel'n'or

Donc tu as des données dans une feuille Excel et tu souhaites les exporter dans un csv

en fait non les données sont issues d'un autre fichier.
en fait excel ne serait utilisé que comme une sorte de fichier temporaire (sans atteindre les 65000 données) avant l'export
28/02/2007, 15h01
ouskel'n'or

Tu ne lis donc pas toutes les lignes
Tu as deux solutions, une avec ton tableau (puisqu'il est fait) et une sans
Mais avant, trois questions
- tu veux bien placer tes 28 données concernant "une parcelle" sur une même ligne ?
- Tu sembles renseigner une feuille de calculs, non ?
- Si oui, que mets-tu dedans ?
A+
28/02/2007, 15h30
Beamish

Citation:

Envoyé par ouskel'n'or

- tu veux bien placer tes 28 données concernant "une parcelle" sur une même ligne ?

oui

Citation:

Envoyé par ouskel'n'or

- Tu sembles renseigner une feuille de calculs, non ?

en effet le fichier excel est "préparé" avec les intitulé des colonnes

Citation:

Envoyé par ouskel'n'or

- Si oui, que mets-tu dedans ?

les données du fichier FANTOIR qui sont en l'état difficilement exploitable
28/02/2007, 15h45
ouskel'n'or

Et cette feuille, après traitement, tu peux bien la relire, non ? Ce ne sont pas les bonnes données que tu places dedans ?
Après je te réponds ;)
28/02/2007, 15h59
Beamish

en effet ce sont bien les bonnes données....
les données initiales du fichier fantoir sont en fait mise "bout à bout" sans séparateur et donc à moins de connaitre précisément la description des champs et de leur longueur, elles sont difficilement exploitables, enfin pour moi en tout cas.

Bon, alors le code que je t'ai donné fonctionne. sans utiliser le tableau.
Si tu veux quand même l'utiliser, alors, après tes lignes
Code:

1 2 Endif Loop
bref, à la fin de ta boucle, tu peux faire :
Code:

1 2 3 4 5 6 7 8 Open "D:\txt\LeFichier.csv" For Output As #1 For i = 1 To 27 Print #1, mazone(i) + ";"; 'pour avoir "," comme séparateur tu remplaces ";" par "," Next i 'i passe à 28 Print #1, mazone(i) 'dernière donnée de la ligne Close #1
Ceci dit, tu peux imbriquer la lecture et l'écriture en ouvrant les deux fichiers à la fois
A+

28/02/2007, 16h43
Beamish
excuse moi de ma réponse naïve mais c'est bien ici que j'insere le code ?
Code:

1 2 3 4 5 6 7 8 9 10 11 Set MaParcelle = MaParcelle.Offset(1, 0) End If End If Loop 'code a inserer Close #1 ' Ferme le fichier.' fin d'import MsgBox "L'import est terminé !"
ci c'est bien cela alors les données sont bien dans le fichier excel mais dans le csv seul les ";" sont insérés...
28/02/2007, 17h10
ouskel'n'or

C'est bien ça.
Là ton tableau est renseigné, et tu renseignes le txt mais pour une ligne seulement, cette ligne comportant 28 données.
C'est bien ce que tu veux ?
28/02/2007, 17h25
Beamish

1 pièce(s) jointe(s)

en fait c'est bien plus d'une ligne que je souhaite insérer mais tout le fichier originel (cf. un extrait en pj - supprimer l'extension .txt pour avoir l'extension réelle)

Autant pour moi, j'avais oublié.
Okay, on repart du début

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Open monfichier For Input As #1
Open "D:\txt\LeFichier.csv" For Output As #2
Do While Not EOF(1)
    ' Ne lit que les chaînes de caractères ne retourne pas
    ' les codes CHr(13)
    Input #1, maligne '
' En tête commun à tous les articles
 
    mazone(1) = Mid(Trim(maligne), 1, 2) 'ccodep
    mazone(2) = Mid(Trim(maligne), 3, 1) 'ccodir
    mazone(3) = Mid(Trim(maligne), 4, 3)  'ccocom
 
'If mazone(3) = "066" Then 'Selectionne la communne (66 = CHATELLERAULT)
 
    If Len(Trim(Mid(Trim(maligne), 74, 1))) = 0 Then 'supprime les entités annulées "O" et "Q" en (74,1)
 
        mazone(4) = "'" + Mid(Trim(maligne), 7, 4) 'ccoriv (Impose une zone texte)
        mazone(5) = Mid(Trim(maligne), 11, 1) 'cleriv
        mazone(6) = Mid(Trim(maligne), 12, 4) 'natvoi
        mazone(7) = Mid(Trim(maligne), 16, 26) 'libvoi
        mazone(8) = Mid(Trim(maligne), 42, 1) 'filler
        mazone(9) = Mid(Trim(maligne), 43, 1) 'typcom
        mazone(10) = Mid(Trim(maligne), 44, 2) 'filler
        mazone(11) = Mid(Trim(maligne), 46, 1) 'ruractu
        mazone(12) = Mid(Trim(maligne), 47, 2) 'filler
        mazone(13) = Mid(Trim(maligne), 49, 1) 'carvoi
        mazone(14) = Mid(Trim(maligne), 50, 1) 'indpop
        mazone(15) = Mid(Trim(maligne), 51, 2) 'filler
        mazone(16) = Mid(Trim(maligne), 53, 7) 'popreel
        mazone(17) = Mid(Trim(maligne), 60, 7) 'poppart
        mazone(18) = Mid(Trim(maligne), 67, 7) 'popfict
        mazone(19) = Mid(Trim(maligne), 74, 1) 'annul
        mazone(20) = Mid(Trim(maligne), 75, 4) 'janannul
        mazone(21) = Mid(Trim(maligne), 82, 4) 'jancrea
        mazone(22) = Mid(Trim(maligne), 89, 15) 'filler
        mazone(23) = Mid(Trim(maligne), 104, 5) 'ccovoi
        mazone(24) = Mid(Trim(maligne), 109, 1) 'indclvoi
        mazone(25) = Mid(Trim(maligne), 110, 1) 'indldnb
        mazone(26) = Mid(Trim(maligne), 111, 2) 'filler
        mazone(27) = Mid(Trim(maligne), 113, 8) 'motclass (permet de restituer l'ordre alphabétique)
        mazone(28) = Mid(Trim(maligne), 121, 30) 'filler
 
        For i = 1 To 27
            Print #1, mazone(i) + ";";
            'pour avoir "," comme séparateur tu remplaces ";" par ","
        Next i
        'i passe à 28
        Print #1, mazone(i) 'dernière donnée de la ligne
        Redim Mazone(28) 
        'pour nettoyer le tableau (tu testes en mettant 1 point d'arret sur loop...
 
Loop
Close #1    ' Ferme le fichier.' fin d'import
Close #2

Tu dis

28/02/2007, 17h53
Beamish
Citation:
Envoyé par ouskel'n'or

Code:

1 2 Redim Mazone(28)

Tu dis
tableau déjà dimensionné...
28/02/2007, 17h57
Beamish

1 pièce(s) jointe(s)

voici le fichier excel, modifier l'extension txt en xls
28/02/2007, 17h57
ouskel'n'or

Ok ! Je n'ai pas testé. Dommage car si jamais tu as une ligne incomplète (?) ton tableau conserve la valeur de la ligne précédente
Si c'est las (possibilité de ligne incomplète) tu dis, on arrangera ça
Là, tu supprimes la ligne. ;)
A+
28/02/2007, 18h06
Beamish

c'est sur mais normalement (le peu que j'ai compris du fichier source) toutes les lignes sont renseignées...
28/02/2007, 18h16
ouskel'n'or

Il ne te reste plus qu'à tester ;)
Tiens-nous au courant
A+
02/03/2007, 11h34
Beamish

je l'ai testé il me renvoit l'erreur suivante et renseigne une seule ligne sur le fichier xls et aucune sur le csv :
- Mode d'acces au fichier incorrect en pointant sur :
Print #1, mazone(i) 'dernière donnée de la ligne
02/03/2007, 11h41
ouskel'n'or

Tu as bien déclaré ton tableau... Je crois que oui.
As-tu modifié le code ?
Tu n'aurais pas mis 28 ici ?

Code:

For i = 1 To 27

A+

voici le code utilisé c'est bien 27 qui est renseigné et le tableau est déclaré par ailleurs...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
       Sub importFANTOIR()
 
Set Monclasseur = ThisWorkbook
Monclasseur.Activate
 
' Import du fichier FANTOIR
 
ChDir "H:\Cadastre2006\fichiers" ' Emplacement du fichier source
ChDrive "H:"
monfichier = Application.GetOpenFilename
If monfichier <> False Then
    rep = MsgBox("Ouvrir : " & monfichier, vbOKCancel)
End If
If rep = 1 Then
' recompose le nom à l'envers pour détecter le premier \
   toto = Len(Trim(monfichier))
   montest = ""
   titi = Trim(monfichier)
   Do
   titi = Right(titi, 1)
       If titi = "\" Then
        ' recompose le mot à l'endroit
         toto = Len(montest)
         titi = montest
         Do
           titi = Right(titi, 1)
           p = p + 1
           Monfic = Monfic + titi
           titi = Mid(montest, 1, toto - p)
           If p = i Then Exit Do
         Loop
         Exit Do
        Else
           i = i + 1
           montest = montest + titi
           titi = Mid(Trim(monfichier), 1, toto - i)
       End If
    Loop
 
If UCase(Left(Monfic, 4)) = "FANR" Then
 
Application.Cursor = xlWait
Application.DisplayStatusBar = True
Application.StatusBar = "Import du fichier Identifiant du Local en cours ..."
 
Application.ScreenUpdating = False
 
Dim maligne As String
' longueur  de l'enregistrement total
Dim mazone(150) As String
 
' Ouvre le fichier en lecture.
Open monfichier For Input As #1
Direction = False
 
Open "H:\Cadastre2006\fichiers\test_csv.csv" For Output As #2
 
' Liste des rues
Sheets("Fantoir").Select
Range("A2:AZ30000").Clear
Set MaParcelle = Range("A2")
 
 
 
 
Do While Not EOF(1)
    ' Ne lit que les chaînes de caractères ne retourne pas
    ' les codes CHr(13)
    Input #1, maligne '
 
 
' En tête commun à tous les articles
 
mazone(1) = Mid(Trim(maligne), 1, 2) 'ccodep
mazone(2) = Mid(Trim(maligne), 3, 1) 'ccodir
mazone(3) = Mid(Trim(maligne), 4, 3)  'ccocom
 
'If mazone(3) = "066" Then 'Selectionne la communne (66 = CHATELLERAULT)
 
If Len(Trim(Mid(Trim(maligne), 74, 1))) = 0 Then 'supprime les entités annulées "O" et "Q" en (74,1)
 
mazone(4) = "'" + Mid(Trim(maligne), 7, 4) 'ccoriv (Impose une zone texte)
mazone(5) = Mid(Trim(maligne), 11, 1) 'cleriv
mazone(6) = Mid(Trim(maligne), 12, 4) 'natvoi
mazone(7) = Mid(Trim(maligne), 16, 26) 'libvoi
mazone(8) = Mid(Trim(maligne), 42, 1) 'filler
mazone(9) = Mid(Trim(maligne), 43, 1) 'typcom
mazone(10) = Mid(Trim(maligne), 44, 2) 'filler
mazone(11) = Mid(Trim(maligne), 46, 1) 'ruractu
mazone(12) = Mid(Trim(maligne), 47, 2) 'filler
mazone(13) = Mid(Trim(maligne), 49, 1) 'carvoi
mazone(14) = Mid(Trim(maligne), 50, 1) 'indpop
mazone(15) = Mid(Trim(maligne), 51, 2) 'filler
mazone(16) = Mid(Trim(maligne), 53, 7) 'popreel
mazone(17) = Mid(Trim(maligne), 60, 7) 'poppart
mazone(18) = Mid(Trim(maligne), 67, 7) 'popfict
mazone(19) = Mid(Trim(maligne), 74, 1) 'annul
mazone(20) = Mid(Trim(maligne), 75, 4) 'janannul
mazone(21) = Mid(Trim(maligne), 82, 4) 'jancrea
mazone(22) = Mid(Trim(maligne), 89, 15) 'filler
mazone(23) = Mid(Trim(maligne), 104, 5) 'ccovoi
mazone(24) = Mid(Trim(maligne), 109, 1) 'indclvoi
mazone(25) = Mid(Trim(maligne), 110, 1) 'indldnb
mazone(26) = Mid(Trim(maligne), 111, 2) 'filler
mazone(27) = Mid(Trim(maligne), 113, 8) 'motclass (permet de restituer l'ordre alphabétique)
mazone(28) = Mid(Trim(maligne), 121, 30) 'filler
 
 
Monclasseur.Sheets("Fantoir").Select
MaParcelle.Select
 
 
 For i = 1 To 27
       Selection.Offset(0, i - 1).Formula = mazone(i)
 Next i
 
Print #1, mazone(i) 'dernière donnée de la ligne
 
 
Set MaParcelle = MaParcelle.Offset(1, 0)
 
'End If
 
End If
 
Loop
Close #1    ' Ferme le fichier.' fin d'import
Close #2
 
MsgBox "L'import est terminé !"
 
Call Majecran
 
Else
    rep = MsgBox("Le fichier d'import doit être FANR.* !", vbCritical)
    rep = MsgBox("L'import est annulé !", vbCritical)
End If
 
Else
     rep = MsgBox("L'import est annulé !", vbCritical)
End If
Call Majecran
End Sub
 
Sub Majecran()
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = True
'redonne la main à Excel sur la barre des tâches
Application.Cursor = xlDefault
End Sub

02/03/2007, 12h16
ouskel'n'or

Alors c'est normal
La ligne

Code:

Selection.Offset(0, i - 1).Formula = mazone(i)

a pour valeur de ligne 0 et de colonne - 1
En début de procédure, tu sélectionne la feuille, pas la cellule
Je vois

Citation:

Sheets("Fantoir").Select
Range("A2:AZ30000").Clear
Set MaParcelle = Range("A2")

Puis

Citation:

Set MaParcelle = MaParcelle.Offset(1, 0)

et tu écris ensuite "Selection.offset...." sans avoir rien sélectionner
Tu pourrais faire

Code:

MaParcelle.Offset((0, i - 1).Value= mazone(i)

mais là tu regarde si c'est bien ce que tu veux faire, je n'ai pas approfondi
Tu dis
A+