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

**Beamish** · 28/02/2007, 14h26

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 !

**helios77** · 28/02/2007, 14h33

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**ouskel'n'or** · 28/02/2007, 14h40

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+

**Beamish** · 28/02/2007, 14h47

voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

**Beamish** · 28/02/2007, 14h49

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

**ouskel'n'or** · 28/02/2007, 15h01

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+