[Résolu]-[Macro] Ajouter des espaces et exporter en fichier txt

[mercuro]

Bonjour à tous,

Je suis en galère car je voudrais créer une macro qui a pour but de remplacer un fichier trop lourd.

Actuellement pour faire une importation de données dans le logiciel de comptabilité (sage 100 i7 si ca intéresse d'autres personnes) j'utilise un fichier excel qui contient trop de formules et d'onglets.

J'aurais besoin d'aide pour la création d'une macro qui irait voir dans la première ligne de chaque colonne le nombre d'espaces à ajouter pour correspondre au format d'importation sage compta et une autres macro qui génère un fichier txt qui reprendrait ce qui a été fait (ajout des espaces et pas de tabulation).

En pj il y a un exemple avec un semblant de début de macro. J'ai essayer plusieurs choses mais rien de concret n'a abouti, c'est le meilleur résultat que j'ai obtenu et plus je fais de nouveaux tests moins j'avance dans ce projet, c'est pour cela que je fais appel à la communauté.

Merci par avance à ceux qu aideront A+

 

[pierrejean]

Bonjour mercuro

Un essai

 

[Modeste]

Bonjour mercuro,

Si tu as du mal à écrire un code, pourquoi ne pas t'y prendre autrement?
Dans ta feuille "export", en A2 (ou en A1, si tes titres doivent contenir des espaces aussi), remets la cellule au format Standard, puis écris:

=DB!B3&REPT(" ";DB!B$1)

recopie en bas et à droite aussi loin que nécessaire.
Tant que la plage est sélectionnée, copie-la et en A2, fais un collage spécial > Valeurs

Enregistre ensuite ton fichier au format texte ... Le résultat n'est pas le même?

[Edit:] salut pierrejean
[Edit2:] pour la postérité (ou pour des prunes ) la formule suivante tronque le texte s'il est plus long que le nombre de caractères renseignés en feuille DB. Dans les autres cas, elle ajoute des espaces en fin de chaîne, jusqu'à concurrence dudit nombre de caractères:

=SI(NBCAR(DB!B3)>DB!B$1;GAUCHE(DB!B3;DB!B$1);DB!B3&REPT(" ";DB!B$1-NBCAR(DB!B3)))

 

[pierrejean]

Re

Salut Modeste
Je ne suis pas sur que le résultat soit le même
En ce qui me concerne je n'ajoute que le nombre d'espaces nécessaires pour arriver au nombre de caractères spécifies en ligne 1
Ceci parce que cela me semble plus logique, mais la demande est bien celle que ta proposition résout (pour peu que j'aie compris correctement ta formule)

 

[Paf]

Bonjour mercuro,

un essai qui génère un fichier texte, à adapter:

Sub MacroMercuro()
Dim i As Integer, j As Integer, Ligne As String, Chemin As String, NomFich As String

Chemin = "C:\Documents and Settings\...\...\" ' à adapter
NomFich = "FICHTEST"    'à adapter
Open Chemin & NomFich For Output As #1
With Worksheets("DB")
For i = 3 To .Range("A65536").End(xlUp).Row 'pour les lignes 3 à la dernière ligne)
    For j = 2 To 8 ' pour les colonnes 1 à 8 (A à H)
        Ligne = Ligne & .Cells(i, j) & Space(.Cells(1, j) - Len(.Cells(i, j)))
    Next
    Print #1, Ligne
    Ligne = ""
Next
End With
Close #1
End Sub

un souci sur la colonne H où on doit avoir un espace de 18 caractères et le texte à insérer fait 19 caractères. non géré par la macro.

A+

Edit : Bonjour Modeste, pierrejean

 

[Modeste]

Re (aussi),

@pierrejean: Je me suis posé la question que tu évoques ... comme il y a déjà parfois 19 caractères dans certains champs (pour lesquels 18 espaces devraient suivre!?) ... je me suis contenté de me poser la question
Je présume que mercuro nous en dira plus un de ces jours?

[Edit:] Salut Paf

 

[Paf]

Re,

Si la valeur en tête de colonne est bien la longueur max de la donnée( complétée d'espaces si nécessaire) , remplacer dans la macro :

        Ligne = Ligne & .Cells(i, j) & Space(.Cells(1, j) - Len(.Cells(i, j)))

par

        Champ = Left(.Cells(i, j), .Cells(1, j))
        Ligne = Ligne & Champ & Space(.Cells(1, j) - Len(Champ))

les données seront tronquées à la taille max prévue.

A+

 

[Dranreb]

Bonjour.
Essayer aussi comme ça :

Sub test()
Dim TE(), C&, L&, TC() As String, Chemin As String, NomFich As String
TE = Feuil2.[B1:H1].Value
ReDim TC(1 To UBound(TE, 2))
For C = 1 To UBound(TE, 2)
  TC(C) = Space$(TE(1, C))
  Next C
TE = Intersect(Feuil2.[B3:H1000000], Feuil2.UsedRange).Value
'ReDim TS(1 To UBound(TE, 1), 1 To 1) <--- INSTRUCTION À SUPPRIMER (vestige de rédaction initiale)
Chemin = "C:\Documents and Settings\...\..." ' à adapter
NomFich = "FICHTEST"  'à adapter
Open Chemin & "\" & NomFich & ".txt" For Output As #1
For L = 1 To UBound(TE, 1)
  For C = 1 To UBound(TE, 2)
    LSet TC(C) = TE(L, C)
    Next C
  Print #1, Join(TC, "")
  Next L
Close #1
End Sub

Bien qu'après "dans la première ligne de chaque colonne" vous disiez "le nombre d'espaces à ajouter", ce qui me parait trop invraisemblable, j'ai interprété "la longueur à atteindre par ajout du nombre d'espaces approprié" … que je n'ajoute finalement même pas puisque je procède autrement !
Un texte trop long pour tenir est tronqué avec ce système.

 

[mercuro]

Re bonjour,

Merci pierrejean, Modeste, Paf et Dranreb vous avez résolu mon problème, et que les données soient tronquées à la taille max prévue c'est parfait.

J'ai apporter des adaptations pour mon cas si cela intéresse une autre personne.

Choix du répertoire (ne pas mettre sur le bureau directement sinon il notera un message d'erreur)
Départ de la macro de la colonne A jusqu'à la colonne ZZ

Sub Export_compta()
Dim TE(), C&, L&, TC() As String, Chemin As String, NomFich As String
TE = ActiveSheet.[A1:zz1].Value
ReDim TC(1 To UBound(TE, 2))
For C = 1 To UBound(TE, 2)
  TC(C) = Space$(TE(1, C))
  Next C
TE = Intersect(ActiveSheet.[a3:zz1000000], ActiveSheet.UsedRange).Value
Chemin = ChoisirRepertoire
NomFich = InputBox("Nom du fichier : ")
Open Chemin & "\" & NomFich & ".txt" For Output As #1
For L = 1 To UBound(TE, 1)
  For C = 1 To UBound(TE, 2)
    LSet TC(C) = TE(L, C)
    Next C
  Print #1, Join(TC, "")
  Next L
Close #1
End Sub
Function ChoisirRepertoire() As String
Dim oFolder As Object
ChoisirRepertoire = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choisir un répertoire", 0)
If (Not oFolder Is Nothing) Then ChoisirRepertoire = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Vous êtes vraiment au top merci !

 

[Dranreb]

Je m'aperçois que j'ai laissé une instruction au final inutile :
ReDim TS(1 To UBound(TE, 1), 1 To 1)
Ce tableau n'est pas utilisé.

 

[mercuro]

Effectivement, je n'avais pas fait attention. Du coup j'ai fais encore deux petites modification la possibilité à l'utilisateur final de choisir le nom du fichier lors de la sauvegarde via une inputbox.
De plus l'activation de la macro sur l'onglet actif car in fine celui ci ne sera lié à un fichier et une feuille en particulier mais sur lequel il y a aura plusieurs modèles d'importation paramétrable par l'utilisateur final.

En tout cas encore merci pour l'aide.

Je m'aperçois que j'ai laissé une instruction au final inutile :
ReDim TS(1 To UBound(TE, 1), 1 To 1)
Ce tableau n'est pas utilisé.