XL 2019 CSV modifier le contenu puis le transformer en xls

[msauvegrain]

Bonjour,
Je voudrais pouvoir traiter un fichier csv par sélection dans une liste d'un répertoire : c:\a_colFR\ contenant les fichiers
puis :

1. Effacer les 6 premières lignes
2. Effacer les 4 dernières lignes
3. Remplacer "Références catalogue" par "Nums"
4. Remplacer "Date d'émission" par " Date d_émission"
5. Remplacer "Date d'expiration" par "Date d_expiration"
6. Enregistrer le fichier modifié en csv
7. Puis le convertir en xls
8. Modifier le format de cellule de la colonne FaceValue en Texte
9. l'enregistrer sous : "X_" & la référence pays de la deuxième ligne du nouveau fichier

Les fichiers joints sont avec l'extension .txt mais ils sont en réalité des csv

Merci d'avance

J'ai été précis cette fois !!!

 

[job75]

Bonsoir msauvegrain,

Les fichiers joints sont avec l'extension .txt mais ils sont en réalité des csv

Ce n'est pas pareil, mettez les fichiers CSV dans un dossier zippé et déposez-le ici.

Par ailleurs faut-il traiter le fichier sélectionné ou tous les fichiers CSV du dossier ?

A+

 

[msauvegrain]

Bonsoir, job75
Je veux traiter tout les fichiers des répertoires, je joins en .zip une partie de ceux d'Afrique . Mais j'ai un dossier par continent : a_asie, a_océanie, a_amérique, a_europe, a_ afrique et un pour les colonies françaises a_colFR

@+, Merci

 

[job75]

Bonjour msauvegrain,

Voyez le fichier joint et cette macro :

Sub Traitement_dossiers()
Dim dossier1$, dossier2, remplace, par, chemin$, fichier$, n&, i, nom$
dossier1 = "Fichiers CSV corrigés\" 'nom du sous-dossier, modifiable
dossier2 = "Fichiers XLS\" 'nom du sous-dossier, modifiable
remplace = Array("é", "É", "Ã~¨", "â", "½", "Références catalogue", "Date d'émission", "Date d'expiration") 'liste modifiablee
par = Array("é", "É", "è", "â", "½", "Nums", "Date d_émission", "Date d_expiration") 'liste modifiable
'---sélection du dossier---
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker) 'sélection du dossier
    If .Show = False Then Exit Sub
    chemin = .SelectedItems(1) & "\"
End With
'---création des sous-dossiers---
If Dir(chemin & dossier1, vbDirectory) = "" Then MkDir chemin & dossier1
If Dir(chemin & dossier2, vbDirectory) = "" Then MkDir chemin & dossier2
'---traitement des fichiers csv---
fichier = Dir(chemin & "*.csv") '1er fichier csv du dossier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si les fichiers sont déjà créés
While fichier <> ""
    n = n + 1
    Workbooks.OpenText chemin & fichier, Comma:=True, DecimalSeparator:=".", Local:=True
    With ActiveWorkbook.Sheets(1)
        .Rows("1:6").Delete
        i = .Range("A" & .Rows.Count).End(xlUp).Row
        .Rows(IIf(i < 3, 1, i - 2)).Resize(3).Delete '3 dernières lignes
        For i = 0 To UBound(par)
            .Cells.Replace remplace(i), par(i), xlPart
        Next i
        i = InStr(fichier, "_csv")
        nom = IIf(i, Left(fichier, i), "stamps_") & .Cells(2, 2)
        .SaveAs chemin & dossier1 & nom & ".csv", 6 'format csv
        .Columns(17).HorizontalAlignment = xlCenter 'centrage de FaceValue
        .SaveAs chemin & dossier2 & nom & ".xls", 56 'format xls
    End With
    ActiveWorkbook.Close
    fichier = Dir 'fichier suivant
Wend
MsgBox IIf(n, n & " fichier" & IIf(n = 1, "", "s") & " CSV traité" & IIf(n = 1, "...", "s..."), "Aucun fichier CSV trouvé...")
End Sub

Chaque dossier est traité séparément en le sélectionnant dans la boîte de dialogue.

Les fichiers créés sont placés dans 2 sous-dossiers créés par la macro.

Je n'ai pas compris pourquoi vous voulez mettre la colonne FaceValue au format Texte, je l'ai juste centrée.

 

[msauvegrain]

Bonsoir Job,

Merci

la colonne FaceValue peut contenir du texte ex : 20c sur 1F

ou pour les timbres récents : lettre verte ou prioritaire

Je vais tester

Merci encore et bonne soirée

 

[job75]

Bah ce n'est pas parce qu'une colonne contient des textes qu'il faut la mettre au format Texte !!!

 

[job75]

Au post #4 j'ai légèrement modifié la définition de la variable nom :

        i = InStr(fichier, "_csv")
        nom = IIf(i, Left(fichier, i), "stamps_") & .Cells(2, 2)

Prenez bien la dernière version du fichier.

 

[msauvegrain]

Bonjour, Job

Après quelques tests je ne comprends pas pourquoi certains fichiers ne sont pas traités correctement.
Ci-joint deux fichiers avec leurs traitements.
Iles Christmas pas de problème, Australie, ne fonctionne pas, je ne sais pas pourquoi ?
Et, je voudrais que le nom du fichier XLS soit du type "X_" & Nom du pays, exemple X_Australie.xls
Merci
@+, Michel

 

[job75]

Bonjour msauvegrain,

Pour l'Australie Workbooks.OpenText ne va pas, je ne sais pas pourquoi.

Par contre Workbooks.Open fonctionne bien sur a_afrique et a_test donc utlisez ce fichier (2) avec :

Sub Traitement_dossiers()
Dim dossier1$, dossier2, remplace, par, chemin$, fichier$, n&, i, a, nom$
dossier1 = "Fichiers CSV corrigés\" 'nom du sous-dossier, modifiable
dossier2 = "Fichiers XLS\" 'nom du sous-dossier, modifiable
'remplace = Array("é", "É", "Ã~¨", "â", "½", "Références catalogue", "Date d'émission", "Date d'expiration") 'liste modifiablee
'par = Array("é", "É", "è", "â", "½", "Nums", "Date d_émission", "Date d_expiration") 'liste modifiable
remplace = Array("Références catalogue", "Date d'émission", "Date d'expiration") 'liste modifiable
par = Array("Nums", "Date d_émission", "Date d_expiration") 'liste modifiable
'---sélection du dossier---
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker) 'sélection du dossier
    If .Show = False Then Exit Sub
    chemin = .SelectedItems(1) & "\"
End With
'---création des sous-dossiers---
If Dir(chemin & dossier1, vbDirectory) = "" Then MkDir chemin & dossier1
If Dir(chemin & dossier2, vbDirectory) = "" Then MkDir chemin & dossier2
'---traitement des fichiers csv---
fichier = Dir(chemin & "*.csv") '1er fichier csv du dossier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si les fichiers sont déjà créés
While fichier <> ""
    n = n + 1
    'Workbooks.OpenText chemin & fichier, Comma:=True, DecimalSeparator:=".", Local:=True
    Workbooks.Open chemin & fichier
    With ActiveWorkbook.Sheets(1)
        .Rows("1:6").Delete
        i = .Range("A" & .Rows.Count).End(xlUp).Row
        .Rows(IIf(i < 3, 1, i - 2)).Resize(3).Delete '3 dernières lignes
        For i = 0 To UBound(par)
            .Cells.Replace remplace(i), par(i), xlPart
        Next i
        i = InStr(fichier, "_csv")
        nom = IIf(i, Left(fichier, i), "stamps_") & .Cells(2, 2)
        .SaveAs chemin & dossier1 & nom & ".csv", 6 'format csv
        .Columns(17).HorizontalAlignment = xlCenter 'centrage de FaceValue
        nom = "X_" & .Cells(2, 2)
        .SaveAs chemin & dossier2 & nom & ".xls", 56 'format xls
    End With
    ActiveWorkbook.Close
    fichier = Dir 'fichier suivant
Wend
MsgBox IIf(n, n & " fichier" & IIf(n = 1, "", "s") & " CSV traité" & IIf(n = 1, "...", "s..."), "Aucun fichier CSV trouvé...")
End Sub

A+

 

[msauvegrain]

Bonsoir Job,

Après quelques essais ..., je suis arrivé à tester ton module et à modifier certaines lignes.
Le résultat me convient mieux, mais il ne fonctionne pas sur certains fichiers, j'en joint un autre qui ne marche pas.
Je sais pourquoi, il y a un ajout de guillemets sur la premier ligne du fichier csv au mauvais endroit.
Est-il possible pour le traitement de définir les limites de texte "" comme pour le séparateur virgule.

Et dernier petit truc, est-il possible de créer un classeur contenant la liste des fichiers csv modifiés.

@+, Michel

 

[msauvegrain]

Bonsoir,
Jai résolu une partie de mon problème en modifiant la ligne :

Workbooks.OpenText chemin & fichier, Origin:=65001, DataType:=xlDelimited, ConsecutiveDelimiter:=False, TextQualifier:=xlDoubleQuote, Comma:=True, DecimalSeparator:=".", Local:=True

Elle force la reconnaissance de la source CSV en UTF-8(Origin) et la valeur de TextQualifier était érronée .

Maintenant, je veux forcer les colonnes E F et Q en format de cellule Texte et les colonnes G et H en décimal.

Qqn a une idée ?

Je joins le fichier modifié,

Pour Staple 1600 je voudrais inclure le traitement des noms dans la procédure.

Merci de votre aide

 

[medelci]

BONJOUR