Export délimité en TXT

Version imprimable

2 pièce(s) jointe(s)

Bonjour à tous,

Je souhaite produire un fichier TXT avec un nombre précis de caractères pour chaque colonne.
En effet, mon export devant aller être importer par un software et chaque colonne doit débuter à un endroit bien précis.

J'ai réussi à dégoter un code sur internet qui fonctionne plutôt pas mal .... mais (ça serait pas drôle sinon), j'ai l'impression qu'il rajoute des espaces vides non désirés entre chaque colonne après le nombre de caractères souhaités.

Un exemple sera beaucoup plus explicite :

Je souhaite donc délimiter mes colonnes comme suit :

Colonne A : 2
Colonne B : 20
Colonne C : 11
Colonne D : 48

Le résultat souhaité :

C10000000000000000000056041017300MONIET

On remarque donc bien que la colonne B qui reprend le code (00000000000000000000) démarre bien au 3ème caractère de ma ligne.
La colonne C démarre bien aux 23eme caractère de ma ligne.

Le résultat obtenu :

Pièce jointe 584761

Je ne comprends pas, comment avec une délimitage précis de mes colonnes, j'obtiens des espaces non désirés.
Le message ne le montre pas clairement, mais j'obtiens :

12 espaces entre la colonne A & B
8 espaces entre la B & C
3 espaces entre la C & D

Je vous joints le code ainsi que le fichier contenant le code.
D'avance merci pour votre aide.
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 Public Sub txtproduction() Dim myFile As String, rng As Range, cellValue As Variant, I As Integer, J As Integer Dim Nomfichier As String Dim chemin As String Dim S(29) As Integer Sheets("formating").Select S(0) = 2 S(1) = 20 S(2) = 11 S(3) = 48 Nomfichier = InputBox("Nom du fichier ?") chemin = ThisWorkbook.Path myFile = chemin & "\" & Nomfichier & ".txt" Set rng = ActiveSheet.UsedRange Open myFile For Output As #1 For I = 1 To rng.Rows.Count For J = 1 To rng.Columns.Count cellValue = rng.Cells(I, J).Value cellValue = Left(cellValue, S(J - 1)) cellValue = cellValue & String(S(J - 1) - Len(cellValue), Chr(32)) If J = rng.Columns.Count Then Print #1, cellValue Else Print #1, cellValue, End If Next J Next I Close #1 End Sub

Salut.

Voici quelque chose qui pourrait convenir, sur base bien sûr d'un tableau structuré.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Test()
  Dim Filename As String
  Dim Channel As Long
  Dim i As Long
  Dim Value As String
  Dim r As Range
 
  Channel = FreeFile
  Filename = "c:\data\temp\Export.txt"
  Open Filename For Output As #Channel
    For i = 1 To Range("tableau1").Rows.Count
      Set r = Range("tableau1").ListObject.ListRows(i).Range
      Value = r(1).Value & r(2) & String(20 - Len(r(2).Value), "0") & _
        r(3) & String(11 - Len(r(3).Value), "0") & r(4) & String(48 - Len(r(4).Value), "0")
      Print #Channel, Value
    Next
  Close #Channel
End Sub

On pourrait configurer les colonnes du TXT dans un tableau structuré pour rendre la procédure un peu plus générique.

Bonjour Pierre,

D'abord merci pour votre aide, mais lors du lancement du code, il m'indique "Run-time error 91" Object variable or with block variable not set lorsque j'atteins la ligne en bold du code ci-dessous.
Sauriez vous pourquoi?

D'avance merci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Test()
  Dim Filename As String
  Dim Channel As Long
  Dim i As Long
  Dim Value As String
  Dim r As Range
 
  Channel = FreeFile
  Filename = "\\insim.biz\wpsGroups\BE\Groups\051099\Projecten\Project PeopleSoft 2018\Listing Tasks & Sources\INAMI\Testexportforum.txt"
  Open Filename For Output As #Channel
    For i = 1 To Range("A1:BZ300").Rows.Count
      Set r = Range("A1:BZ300").ListObject.ListRows(i).Range
      Value = r(1).Value & r(2) & String(20 - Len(r(2).Value), "0") & _
        r(3) & String(11 - Len(r(3).Value), "0") & r(4) & String(48 - Len(r(4).Value), "0")
      Print #Channel, Value
    Next
  Close #Channel
End Sub

23/11/2020, 17h30
Pierre Fauconnier

Tu dois avoir délimité ta plage comme un tableau structuré pour pouvoir utiliser le ListObject. est-ce le cas?

Normalement, les données que l'on va envoyer dans un txt sont issues d'un tableau structuré, et il est préférable d'utiliser le nom du tableau plutôt que son emplacement.
23/11/2020, 17h49
Bediro

effectivement cela fonctionne bien mieux avec un tableau structuré.

Un tout grand merci pour votre intervention. Je m'y replonge :)
24/11/2020, 16h17
Bediro

Hello,

je réouvre le sujet suite à une erreur rencontrée dans la génération du Txt.

Code:

r(X) & String(10 - Len(r(X).Value), Chr(32))

Le TXT se produit de façon admirable lorsque le nombre fixé (ici 10) est supérieur au "Len(r(X).value". Il rajoute des 0 comme demandé.
Cependant, si le nombre de caractères fixés est inférieur à la valeur que renvoit "Len(r(X).value", le message d'erreur suivant apparait :

Citation:

Run-time error : 5, Invalid call procedure or argument

Quelle serait la solution pour que le code me renvoit que les 10 premiers caractères de ma cellules même si celle-ci en contient plus.

D'avance merci
24/11/2020, 16h21
Pierre Fauconnier

1 pièce(s) jointe(s)

text = Left(text & "0000000000", 10)

Pièce jointe 584867
24/11/2020, 19h03
Bediro

Citation:

Envoyé par Pierre Fauconnier

text = Left(text & "0000000000", 10)

Correction de mon message précédent, j'ai besoin d'espaces vides (et non pas des 0) lorsque j'ai des espaces manquants. D'où le Chr(32) dans le code vba que j'ai posté plus haut.

Et comment puis-je intégrer votre ligne dans mon code pour le coup? Sachant que j'ai 4colonnes de 250lignes chacunes qui peuvent voir des cellules excéder la taille max.

D'avance merci
24/11/2020, 19h20
Pierre Fauconnier
J'avais cru comprendre que tu voulais les caractères à droite, mais dans une des illustrations, je vois que tu les mets à gauche. De plus, pour éviter de compter les espaces, je préfères ceci qui ajoute les espaces à droite

Code:

Left(Text & String(10, " "), 10)

Si tu veux les espaces à gauche, tu dois utiliser ceci (mais évidemment, ton texte sera éventuellement tronqué au début plutôt qu'à la fin)

Code:

Right(String(10, " ") & Text, 10)

Tu dois utiliser cette technique à la place de l'autre, dans ta ligne r(X) & String(10 - Len(r(X).Value), Chr(32)) qui devient pour des espaces à droite!!
Code:

1 2 Value = r(1).Value & Left(r(2) & String(20, " "), 20) & _ Left(r(3) & String(11, " "), 11) & Left(r(4) & String(48, " "), 48)

Bonsoir,
autre approche.

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
Sub test()
Const Path As String = "C:\Test"
Const Champs As String = "Col1=A Text Width 2" & vbCrLf & _
"Col2=B Text Width 20" & vbCrLf & _
"Col3=C Text Width 11" & vbCrLf & _
"Col4=D Text Width 48" & vbCrLf
Dim cible As String
cible = "TOTO#CSV"
ShemaIni Path, cible, "FixedLength", Champs, True
Dim R As Range
Set R = Sheets("Formating").Range("A1").CurrentRegion
 
 
Dim Cn As Object
 Set Cn = CreateObject("ADODB.Connection")
  Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & Path & "' ;Extended Properties=""text;HDR=Yes;FMT=Delimited(,)"""
 
  For I = 1 To R.Rows.Count
  Cn.Execute (" insert into " & cible & "(A,B,C,D) values('" & R(I, 1) & "','" & R(I, 2) & "','" & R(I, 3) & "','" & R(I, 4) & "')")
  Next
   Cn.Close
  MsgBox "Fin"
End Sub
 
 
Public Sub ShemaIni(Rep As String, fichier As String, Delimited As String, Optional Champs As String = "", Optional NewCsv As Boolean = False)
Dim txt As String
txt = "[" & Replace(fichier, "#", ".") & "]" & vbCrLf & "Format=" & Delimited
If Champs <> "" Then txt = txt & vbCrLf & Champs
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Rep & "\schema.ini", 2, True)
NewFichier.Write txt
NewFichier.Close
If NewCsv = True Then
    Set NewFichier = fso.OpenTextFile(Rep & "\" & Replace(fichier, "#", "."), 2, True)
    NewFichier.Write ""
    NewFichier.Close
 
 
End If
Set NewFichier = Nothing
Set fso = Nothing 
End Sub

Après on peut imaginer une requête paramètrable!

24/11/2020, 21h19
Pierre Fauconnier

Citation:

Envoyé par Thumb down

[...]

:plusser:

1 pièce(s) jointe(s)

hello,

Citation:

Envoyé par Bediro

Je souhaite produire un fichier TXT avec un nombre précis de caractères pour chaque colonne.
J'ai réussi à dégoter un code sur internet qui fonctionne plutôt pas mal .... mais (ça serait pas drôle sinon), j'ai l'impression qu'il rajoute des espaces vides non désirés entre chaque colonne après le nombre de caractères souhaités.

ton code initial est presque bon, le problème se situe au niveau de la ligne

Code:

Print #1, cellValue,

avec une virgule à la fin, le Print rajoute des espaces entre chaque colonne
Par contre si tu mets un point-virgule à la fin tu n'auras pas d'espaces :

Code:

Print #1, cellValue;

Avec ce 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 Public Sub txtproduction() Dim myFile As String, rng As Range, cellValue As Variant, I As Integer, J As Integer Dim Nomfichier As String Dim chemin As String Dim Width As Variant Width = Array(2, 20, 11, 48, 12, 8, 7, 32, 4, _ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, _ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) ' 4, 10, 7, 7, 40, 40, 1, 1, 15, 1, _ ' 8, 8, 1, 1, 1, 1, 2, 2, 1, 1) Sheets("formating").Select Nomfichier = InputBox("test n°?") chemin = ThisWorkbook.Path myFile = chemin & "\" & Nomfichier & ".txt" Set rng = ActiveSheet.UsedRange Open myFile For Output As #1 For I = 1 To rng.Rows.Count For J = 1 To rng.Columns.Count cellValue = rng.Cells(I, J).Value cellValue = Left(cellValue, Width(J - 1)) cellValue = cellValue & String(Width(J - 1) - Len(cellValue), Chr(32)) If J = rng.Columns.Count Then Print #1, cellValue Else Print #1, cellValue; End If Next J Next I Close #1 End Sub
J'obtiens ceci :

Pièce jointe 584949

Ami calmant, J.P