Macro Conversion fichier excel en .csv

Version imprimable

Bonjour, tout d'abord merci aux personnes qui prendront du temps pour me répondre.

Dans le cadre d'un projet je dois crée une macro afin a partir d'un tableau pricing le convertire en fichier .csv (pour ce fichier les séparateurs seront des espaces et non des , ou ; )

En essayant d'être claire a partir de différente colonne de mon tableau excel pricing ,je dois avoir une chaine de 31 caractére de type:
0001603305140001502RANG01 70

Les 6 premiers caractéres ( 000160 ) sont un code fixe qui a terme devra être selectionné par un menu déroulant
Les 13 suivants (3305140001502 ) sont extrait du tableau excel
Les 6 suivants ( RANG01 ) sont un code fixe qui a terme devra être selectionné par un menu déroulant ou pouvant être indiquer dans une case
Les 6 suivants ( 70) sont extrait du tableau excel

Etant un débutant en vba et n'ayant pas fait de macro "complexe" (enfin pour moi ) depuis longtemps je suis un peu perdu.

Voici la macro que j'ai actuellement:
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 Sub exportCustomCSV() Dim PlageB As Object, PlageE As Object, oL As Object, oC As Object, Tmp As String, destinataire As String, concurrent As String, separator As String Set PlageB = ActiveSheet.Range("B3:B47789") Set PlageE = ActiveSheet.Range("E3:E47789") Open "ExportThomas.csv" For Output As #1 destinataire = "000160" concurrent = "RANG01" separator = " " For Ligne = 1 To PlageB.Rows.Count Tmp = destinataire & PlageB.Cells(Ligne, 1).Value & concurrent & separator & PlageE.Cells(Ligne, 1).Value Print #1, Tmp Next Ligne Close End Sub
Je sais que je suis loin du résultat escompté pour l'instant j'ai 2 problémes majeurs: (si vous pensez que ma méthode de priorisation des problémes a régler est mauvaise dite le moi)

1er probléme;Pour mon set de plage
Code:

1 2 Set PlageB = ActiveSheet.Range("B3:B47789") Set PlageE = ActiveSheet.Range("E3:E47789")
Je voudrais remplacer B47789 et E47789 pour qu'il s'adapte a la taille du document en effet sur un autre document la fin du tableau ne sera surement pas la ligne 47789

2eme probléme:
Pour l"extraction de mes 13 caractéres il arrive de temps en temps que la donnée ne comporte pas 13 chiffres de base mais 8-9-10-11-12 ,je voudrais donc compléter
en rajoutant des 0 (par la gauche)afin que cela fasse 13 caractères pour exemple: si la cellule du tableau est 140001502 que dans mon fichier csv celle-ci devienne 0000140001502

Aprés avoir réglés ces problèmes mon objectif et de faire une feuille excel ,ou avec un parcourir la personne pourra mettre son fichier excel et qu'il soit convertir au bon format et enregistrer a un endroit designé.
Pensez-vous que je m'y prend bien ?

Merci de votre aide.

Bonjour,
je suis pas sur d'avoir bien compris!

Code:

1
2
destinataire = Format(160, "000000") '6 zéro pour le format!
concurrent = Left("RANG01" & Space(12), 12) 'pour un logueur de 12  caractères!

14/04/2015, 11h36
Tomz57

Bonjour rdurupt,

J'ai bien pris en compte ta remarque pour le destinataire que j'ai donc modifié.

Pour le conccurent je l'ai aussi inclus ,bien que je t'avoue que j'ai pas compris l'effet de "Space(12), 12)" ?

As tu une idée pour mon probléme #2 afin d'ajouté des 000 sur ma partie de 13 caractéres quand nécessaire.

Merci
14/04/2015, 12h54
pc75
Bonjour,

Pour ajouter des zéros à gauche dans la limite de 13 caractères, tu peux faire comme ça :
Code:

1 2 3 Chaine = "123456789" NewChaine = String(13 - Len(Trim(Chaine)), "0") & Chaine

Code:

1
2
3
4
5
Dim Nbl As Long
Nbl = ActiveSheet.Range("B" & ActiveSheet.Cells.Rows.Count).End(xlUp).Row
If Nbl < ActiveSheet.Range("E" & ActiveSheet.Cells.Rows.Count).End(xlUp).Row Then Nbl = ActiveSheet.Range("E" & ActiveSheet.Cells.Rows.Count).End(xlUp).Row
Set PlageB = ActiveSheet.Range("B3:B" & Nbl)
Set PlageE = ActiveSheet.Range("E3:E" & Nbl)

14/04/2015, 13h06
patricktoulon
Bonjour
pour le 1 er problème
Code:

1 2 Set PlageB = ActiveSheet.Range("B3:B" & Cells(Rows.Count, 2).End(xlUp).Row) Set PlageE = ActiveSheet.Range("E3:E" & Cells(Rows.Count, 5).End(xlUp).Row)
durupt:

Code:

If Nbl < ActiveSheet.Range("E" & ActiveSheet.Cells.Rows.Count).End(xlUp).Row Then Nbl = ActiveSheet.Range("E" & ActiveSheet.Cells.Rows.Count).End(xlUp).Row

je n'en vois pas l'intérêt si c'est pour copier des cellules vides
ce qui donnerait des lignes incomplètes ou les cellules seraient remplacée forcement par "00000000000000" (14 zero)

Bonjour Patrick,
soit on uilise UsedRange.rows.count soit on compare le Nbl car rien ne dit qu'il y a le même nombre de valeur dans les 2 cas!
Code:

1 2 3 4 Nbl = ActiveSheet.Range("E" & ActiveSheet.UsedRange.Rows.Count).Row Set Plage = ActiveSheet.Range("B3:E" & Nbl) Tmp = destinataire & Plage.Cells(Ligne, 1).Value & concurrent & separator & Plage.Cells(Ligne, 3).Value

14/04/2015, 15h56
Tomz57
Tout d'abord merci
- rdurput
- patricktoulon
- pc75
j'ai réussi, grâce à vous, à régler mes 2 problèmes.
Je vais continuer a travailler dessus.

:fleche: J'ai constaté une certaine volatilité sur le fait de l'enregistrement de mon fichier.csv en effet mon fichier excel pricing étant dans le dossier mesdocuments/macroexcel normalement mon fichier.csv doit s'enregistrer dans le dossier macroexcel ,desfois celui-ci s'enregistre dans le dossier mesdocuments.

Quelqu'un a-t-il une solution pour fixer cela ?

Cordialement

Code:

1
2
chemin=thisworkbook.path
chemincomplet=chemin & "\" & nomdetonfichier & ".ton extention"

et pour etre plus precis

le debut de ton code

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub exportCustomCSV()
 
 
Dim PlageB As Object, PlageE As Object, oL As Object, oC As Object, Tmp As String, destinataire As String, concurrent As String, separator As String
 Dim fichier
 fichier = ThisWorkbook.Path & "\" & "ExportThomas.csv"
Set PlageB = ActiveSheet.Range("B3:B47789")
Set PlageE = ActiveSheet.Range("E3:E47789")
 
 
Open fichier For Output As #1

Bonjour,

J'ai de nouveau un problème en effet dans l'une de mes colonnes qui était un prix donnée sous forme 1,50 ,je devais le transformé afin qu'il devienne 000150 ,en m'inspirant de la formule donné précédemment pour rajouter des zéro a mon code de 13 caractéres (quand celui ci n'en comporté que 8-9-10...) je pensais avoir réussis.

J'ai un probléme majeure ,en effet lorsque le prix finit par un zéro celui-ci est supprimer ,pour exemple 1,50 devient 000015 alors que l'objectif est qu'il devienne 000150

Je vous copie toute ma macro.
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 Sub exportCustomCSV() Dim PlageB As Object, PlageE As Object, oL As Object, oC As Object, Tmp As String, destinataire As String, _ concurrent As String, Ean As String, NewEan As String, Price As String, NewPrice As String Dim fichier fichier = ThisWorkbook.Path & "\" & "ExportThomasnospace.csv" Set PlageB = ActiveSheet.Range("B3:B" & Cells(Rows.Count, 2).End(xlUp).Row) Set PlageE = ActiveSheet.Range("E3:E" & Cells(Rows.Count, 5).End(xlUp).Row) Open "ExportThomasnospace.csv" For Output As #1 destinataire = "000160" concurrent = "RANG01" For Ligne = 1 To PlageB.Rows.Count Ean = PlageB.Cells(Ligne, 1).Value NewEan = String(13 - Len(Trim(Ean)), "0") & Ean Price = Replace(PlageE.Cells(Ligne, 1).Value, ",", "") NewPrice = String(6 - Len(Trim(Price)), "0") & Price Tmp = destinataire & NewEan & concurrent & NewPrice Print #1, Tmp Next Ligne Close End Sub
Le problème se situe donc dans la partie
Code:

1 2 Price = Replace(PlageE.Cells(Ligne, 1).Value, ",", "") NewPrice = String(6 - Len(Trim(Price)), "0") & Price
Mais je ne sais pas comment lui faire ne pas supprimer les zéro qui parte de la droite .

En vous remerciant !

Bonne journée

Bonjour,

Tu veux tester ça ?

Code:

1
2
3
4
5
6
7
 
 Ean = PlageB.Cells(Ligne, 1).Value
 If InStr(1, Ean, ",") > 0 Then
    Ean = Replace(CStr(Ean), ",", "")
    Ean = Ean * 10
   End If
   NewEan = String(13 - Len(Trim(Ean)), "0") & Ean

15/04/2015, 17h42
Tomz57

Bonjour pc75,merci de ta réponse.

Mon probléme de zéro est sur ma partie price ,néanmoins j'ai essayé de transcrire ce bout de code pour la partie price ,cela na pas marché et cela supprime toujours les 0 a la fin de mes prix.

J'ai peux-être mal appliqué ta formule.

C'est assez génant (car un prix a 1 € devient un prix a 1 centime € ^^ )

Merci de votre aide.

Cordialement
15/04/2015, 17h52
Invité

Bonjour,
Ean =format( Replace(CStr(Ean), ",", ""),string(13,"0"))
16/04/2015, 10h46
Tomz57
Bonjour, un amis ma aidé pour mon probléme de suppression de zéro. (pour rappel un prix tel que 1,90 € devenait 000019 au lieu de 000190).

Voiçi le code que j'ai utilisé.
Code:

1 2 3 Price = PlageE.Cells(Ligne, 1).Value Price = Price * 100 NewPrice = String(6 - Len(Trim(Price)), "0") & Price
Mon objectif maintenant est de crée une page excel type ,ou avec un parcourir la personne pourrait mettre un lien vers son fichier excel a transformé en .csv.

Je voudrais aussi rajouter des cases afin que la personne puisse changer une partie fixe, pour exemple: 0001603760118601748RANG01000555 je voudrais pouvoir modifier ce qui est en gras avec une case ou un menu déroulant.

Qqn a peut être un "tutorial" ou un exemple de code pour m'aider ?

Cordialement et merci de votre aide.