Macro pour formater un fichier texte ou excel [Résolu]

Macro pour formater un fichier texte ou excel [Résolu] - VB/VBA/VBS - Programmation

Marsh Posté le 07-04-2010 à 11:12:18    

Bonjour à tous,
 
Je tiens dans un premier temps à dire que je suis un noob en matiére de Macro sous Excel.
J'ai juste fais un peu de VBA au lycée et je sais qu'on commence une macro par Sub et on fini par End Sub  :sarcastic:  
 
Je souhaiterais exporter dans un fichier texte, une base de données sous excel.
La premiére ligne correspond au nom des champs.
 
La macro en question doit pouvoir créer un fichier texte avec toutes les valeurs de cellules (mot, chiffre et nom de champs) entre guillemets et créer une sépration en point-virgule.
 
On doit obtenir quelque chose comme ça dans le fichier texte final:
"Nom";"Prenom";"Age"
"Lilou";"Dallas";"25"
"Corbene";"Dallas";"32"
 
(désolé pour l'exemple j'avais que ça en tête  :D )
 
J'espére avoir été le plus clair possible.
Je vous remercie de votre aide.
 
Cordialement,


Message édité par GohanSSj2 le 03-05-2010 à 13:52:45
Reply

Marsh Posté le 07-04-2010 à 11:12:18   

Reply

Marsh Posté le 07-04-2010 à 14:31:40    

Hello
 
Moi j'aime bien ton exemple ! C'est green green green !
 
Il suffit d'enregistrer une macro, d'enregistrer ton fichier au format CSV, de specifier dans les options d'enregistrements que la 1ere ligne contient les noms de champ.
 
Cordialement


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 07-04-2010 à 15:05:57    

Merci de ta réponse mais je souhaite automatiser tout ça.
Le but est d'ajouter un un VBA dans ce que j'ai deja créer (pour remplacer des caractere, virer des espaces, etc).
Je doit ensuite pouvoir mettre à disposition cette macro et les gens auront juste à l'executée pour mettre en forme le fichier qu'il on ouvert.
 
Pour cette partie de la macro, elle doit comporter une partie Exportation avec le séparateur ";".
 
Je travail actuellement sur la partie qui met des guillemets dans chaque cellules (elle met tout entre guillemets)
 
Sinon je connaissais deja cette possibilité ^^ mais merci comme même!

Reply

Marsh Posté le 07-04-2010 à 15:59:50    

Je ne comprends pas...
Pourquoi gérer le separateur alors que l'export en CSV le fait tout seul...
 
Gérer les guillemets ok, si tu as du texte dans une cellule comme cela :
Corben a dit "mais green comment ?"
donne
"Corben a dit ""mais green comment ?"""
Forcement, il faut doubler les guillemets...
 
Sauf, qu'avec l'export en CSV il le gere tout seul aussi...
 

  • Exemple :


Dans Excel :
 
Col1                Col2
  1                    Corben a dit "mais green comment ?"

 
On exporte, et on a bien un fichier CSV :
Col1;Col2
1;"Corben a dit ""mais green comment ?"""

 
Donc... c'est quoi ta question concretement ?


Message édité par SuppotDeSaTante le 07-04-2010 à 16:06:26

---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 07-04-2010 à 16:49:14    

lol bon c'est vrai que je ne suis peut-être pas trés clair.
 
Le but:
On dispose d'une base de données sur laquelle on peut importer des données au format .txt . Ce fichier n'est pas utilisable en l'état par un logiciel de traitement de données. Je souhaite donc que la personne qui ouvre ce fichier txt avec Excel n'est plus qu'à exécuter ma macro pour obtenir un fichier txt lisible par le logiciel de traitement de données.
 
Disons qu'il me semblait que l'exportation était possible avec une macro.
Sans que la tiers personne n'est à cliquer à droite et à gauche pour exporter son fichier comme il faut, avec les bons séparateur. Il faudrait que ce soit transparent pour elle.

Reply

Marsh Posté le 08-04-2010 à 11:29:28    

Donc, tu importes un fichier, que tu traites, et ensuite tu l'exportes pour etre exploitable dans ta base de données ?


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 08-04-2010 à 15:01:24    

Tout à fait, enfin pour être exploitable par le logiciel de traitement.
BDD -> Fichier TXT -> Traitement par Macro -> Exportation fichier (CSV, TXT) -> importation dans logiciel de traitement

Reply

Marsh Posté le 08-04-2010 à 16:24:43    

C'est quoi la BDD en question ?
C'est elle qui exporte ou un logiciel tiers l'attaque pour en extraire un TXT ?


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 08-04-2010 à 17:05:51    

On exporte manuellement.
Les gens se débrouille avec ça, car ils vont choisir leurs propres paramétres à intégrés dans le fichier txt. C'est aprés cela que ma macro rentre en jeu. Je l'ais bientot fini mais tes idées sont les bienvenues. Le dernier probléme que j'ai c'est que lorsque ma macro exporte au format CSV, tout va bien, mais dés que je change l'extension par txt, cela me triple mes guillemets :'( au lieu de garder les simple guillemets.
 
Je posterais mon code demain.
 
Mais je suis preneur de toute suggestion ^^

Reply

Marsh Posté le 08-04-2010 à 19:43:48    

Etant donné que tu recodes tout, ";" guillemets etc. n'exporte pas en csv mais directement en txt
 
J'attends de voir ta macro


---------------
Soyez malin, louez entre voisins !
Reply

Marsh Posté le 08-04-2010 à 19:43:48   

Reply

Marsh Posté le 09-04-2010 à 09:09:56    

Bon voila mon code :
Tout n'est pas de moi, j'ai mis une semaine a regarder se qui se fait, piocher des bouts de code et les adapter.
 

Code :
  1. ' Remplacement des points par des virgules
  2. MsgBox "Remplacement des points par des virgules"
  3. Cells.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder _
  4.         :=xlByColumns, MatchCase:=False
  5.        
  6. ' Suppression des informations complémentaires sur les Codes BSS (/Fxx /H etc)
  7. MsgBox "Suppression des informations complémentaires sur les Codes BSS"
  8. Rows("1:1" ).Select
  9.     Selection.Find(What:="CODPT", After:=ActiveCell, LookIn:=xlValues, _
  10.         LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
  11.         MatchCase:=False).Select
  12. Range(Selection, Selection.End(xlDown)).Select
  13. For Each c In Selection
  14.     c.Value = Left(c.Value, 10)
  15. Next c
  16. ' Ajout des guillemets pour chaque valeur
  17. MsgBox "Ajout des guillemets pour chaque valeur"
  18. Range("A1" ).Select
  19. Range(Selection, Selection.End(xlToRight)).Select
  20. Range(Selection, Selection.End(xlDown)).Select
  21. For Each c In Selection
  22.     c.Value = Chr(34) & c.Value & Chr(34)
  23. Next c
  24. ' Exportation du fichier au format CSV
  25. MsgBox "Exportation du fichier"
  26. Dim Lecteur As String, Chemin As String
  27.     Dim Message As String, MonFichier As String
  28.    
  29.     Lecteur = "C:"
  30.     Chemin = "\Documents and Settings\" & TrouveUtilisateur
  31.     Chemin = Chemin & "\Mes Documents\"
  32.    
  33.     If DossierExiste(Lecteur & Chemin) Then
  34.         MonFichier = Lecteur & Chemin & "Conversion" & ".csv"
  35.         ActiveWorkbook.SaveAs Filename:=MonFichier, _
  36.             FileFormat:=xlCSV, Password:="", WriteResPassword:="", _
  37.             ReadOnlyRecommended:=False, CreateBackup:=False
  38.         Message = "Fichier créé dans " & Lecteur & Chemin
  39.     Else
  40.         Chemin = "\Temp\"
  41.         If DossierExiste(Lecteur & Chemin) Then
  42.             MonFichier = Lecteur & Chemin & "Conversion" & ".csv"
  43.             ActiveWorkbook.SaveAs Filename:=MonFichier, _
  44.                 FileFormat:=xlCSV, Password:="", WriteResPassword:="", _
  45.                 ReadOnlyRecommended:=False, CreateBackup:=False
  46.             Message = "Fichier créé dans " & Lecteur & Chemin
  47.         Else
  48.             Message = "Impossible de trouver un répertoire valide!"
  49.         End If
  50.     End If
  51.    
  52.     MsgBox Message
  53. End Sub
  54. '
  55. ----------------------------------------------------------------------
  56. Function TrouveUtilisateur() As String
  57.     Dim oWsh As Object, oWshEnv As Object
  58.    
  59.     Set oWsh = CreateObject("WScript.Shell" )
  60.     Set oWshEnv = oWsh.Environment("PROCESS" )
  61.     TrouveUtilisateur = oWsh.ExpandEnvironmentStrings("%username%" )
  62.     Set oWshEnv = Nothing
  63.     Set oWsh = Nothing
  64.    
  65. End Function
  66. '
  67. -----------------------------------------------------------------------
  68. Function DossierExiste(ByVal NomDossier As String) As Boolean
  69.     Dim objFS As Object, objDossier As Object
  70.  
  71.     Set objFS = CreateObject("Scripting.FileSystemObject" )
  72.     On Error Resume Next
  73.     Set objDossier = objFS.GetFolder(NomDossier)
  74.     If Error = "Chemin d'accès introuvable" Then
  75.         DossierExiste = False
  76.     Else
  77.         DossierExiste = True
  78.     End If
  79.  
  80. End Function
  81. '


 
Bon il n'est peut-être pas bien mis en forme et il y a peut-être plus simple mais au moin il fait ce que je lui demande
 
Pour ce qui est de l'exportation, elle se fait au format CSV ce qui induit un séparateur.
Il faudrait que je trouve une fonction qui me permet de choisir mon séparateur et mon fichier de sortie.
Je vais travailler sur ça se matin histoire de finir cette macro avant ce soir.

Reply

Marsh Posté le 09-04-2010 à 09:14:14    

Ah oui et lorsque je change dans le code en .txt à la ligne 37 et 45, ça me fait le même délire de triplage des guillemet, alors je me suis dis "Bah je n'est qu'à zaper la partie sur l'ajout des guillemets et au changement d'extension il me mettra des guillemets!!" ... et bin non .. il me met rien :'(

Reply

Marsh Posté le 09-04-2010 à 10:01:51    

bon j'ai trouver ce qu'il me faut pour l'exportation:
 

Code :
  1. Dim Range As Object, Line As Object, Cell As Object
  2. Dim StrTemp As String
  3. Dim Separateur As String
  4. Separateur = ";"
  5. Filename = Application.GetSaveAsFilename(Nom_Fichier, "Text Files (*.txt), *.txt" )
  6. Set Range = ActiveSheet.UsedRange
  7. Open Filename For Output As #1
  8. For Each Line In Range.Rows
  9. StrTemp = ""
  10. For Each Cell In Line.Cells
  11. StrTemp = StrTemp & CStr _
  12. (Cell.Text) & Separateur
  13. Next
  14. Print #1, StrTemp '= " "
  15. Next
  16. Close
  17. End Sub


 
Mais maintenant j'ai une erreur "Declaration existante dans la portée en cours" :'(  ça veut dire quoi !!!  J'ai jamais défini "Dim Range" dans mon code

Reply

Marsh Posté le 09-04-2010 à 10:10:26    

Salut, un exmple vite fait , à adapter sur http://cjoint.com/?ejkjGTEq4U

Reply

Marsh Posté le 09-04-2010 à 10:31:09    

Trés bien ta macro elle fait exactement ce que je veux, cependant je souhaiterais l'insérée dans ma macro. Mais elle est constituée de deux parties et je sais pas quel bout prendre, (a priori le premier mais il semble dépendre d'autre chose)

Reply

Marsh Posté le 09-04-2010 à 10:49:01    

Losque j'insére entiérement dans ma macro l'exportation plante à la ligne:
LastRow = ShDatas.Range("A" & Application.Rows.Count).End(xlUp).Row
 
Pour ceux que ça interresse voici ma macro compléte:

Code :
  1. Private Declare Function QueryPerformanceCounter Lib "Kernel32" (X As Currency) As Boolean
  2. Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (X As Currency) As Boolean
  3. ----------------------------------------------------------
  4. Sub Conversion_ADES_vers_SYSIPHE()
  5. ' Remplacement des points par des virgules
  6. MsgBox "Remplacement des points par des virgules"
  7. Cells.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder _
  8.         :=xlByColumns, MatchCase:=False
  9.      
  10. ' Suppression des informations complémentaires sur les Codes BSS (/Fxx /H etc)
  11. MsgBox "Suppression des informations complémentaires sur les Codes BSS"
  12. Rows("1:1" ).Select
  13.     Selection.Find(What:="CODPT", After:=ActiveCell, LookIn:=xlValues, _
  14.         LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
  15.         MatchCase:=False).Select
  16. Range(Selection, Selection.End(xlDown)).Select
  17. For Each c In Selection
  18.     c.Value = Left(c.Value, 10)
  19. Next c
  20. ' Ajout des guillemets pour chaque valeur
  21. MsgBox "Ajout des guillemets pour chaque valeur"
  22. Range("A1" ).Select
  23. Range(Selection, Selection.End(xlToRight)).Select
  24. Range(Selection, Selection.End(xlDown)).Select
  25. For Each c In Selection
  26.     c.Value = Chr(34) & c.Value & Chr(34)
  27. Next c
  28. ' Exportation du fichier au format TXT
  29. MsgBox "Exportation du fichier"
  30. Dim Sep As String
  31. Dim Debut As Currency, Fin As Currency, Freq As Currency
  32.     ChDir ThisWorkbook.Path
  33.     Application.StatusBar = ""
  34.    
  35.     QueryPerformanceCounter Debut
  36.    
  37.     Sep = ";"
  38.     Ecrire "Essai.txt", Sep
  39.    
  40.     QueryPerformanceCounter Fin
  41.     QueryPerformanceFrequency Freq
  42.     Application.StatusBar = "Terminé : " & Format((Fin - Debut) / Freq, "0.00 s" )
  43. End Sub
  44. --------------------------------------------------------
  45. Private Sub Ecrire(ByVal NomFichier As String, ByVal Separateur As String)
  46. Dim sChaine As String
  47. Dim Ar() As String
  48. Dim i As Long, j As Long, LastCol As Long, LastRow As Long
  49. Dim NumFichier As Integer
  50.     Application.ScreenUpdating = False
  51.     Close
  52.     NumFichier = FreeFile
  53.     LastRow = ShDatas.Range("A" & Application.Rows.Count).End(xlUp).Row
  54.     Open NomFichier For Output As #NumFichier
  55.         For i = 1 To LastRow
  56.             LastCol = ShDatas.Range("IV" & i).End(xlToLeft).Column
  57.             ReDim Ar(LastCol)
  58.             For j = LBound(Ar) To UBound(Ar) - 1
  59.                 Ar(j) = Chr(34) & ShDatas.Cells(i, j + 1) & Chr(34)
  60.             Next j
  61.             sChaine = Join(Ar, Separateur)
  62.             sChaine = Left$(sChaine, Len(sChaine) - Len(Separateur))
  63.             Print #NumFichier, sChaine
  64.         Next i
  65.     Close #NumFichier
  66.     Application.ScreenUpdating = True
  67. End Sub

Reply

Marsh Posté le 09-04-2010 à 10:54:19    

Re,Salut, en gros tu copies la procédure Private Sub Ecrire(ByVal NomFichier As String, ByVal Separateur As String)
et dans ta procédure principale tu insères
Ecrire "Essai.txt", Sep
 
Supprimer toutes les scories pour le temps de calcul
Te renseigner sur CodeName sur http://www.ozgrid.com/VBA/excel-vba-sheet-names.htm et l'intérêt de son utilisation
( ShDatas dans l'exemple )

Reply

Marsh Posté le 09-04-2010 à 11:13:15    

Bon ça y est j'ai réussi !!!!!! :bounce: !!!!!!!
J'ai réutilisé l'ancien code (avant le tiens kiki29) il fallait juste modifier Range dans la partie exportation, je l'ais donc nommée Ranges.
Et maintenant ça marche !!!!! il me demande où enregistrer le fichier et c'est tout bon.
Merci de votre aide comme quoi avec de l'acharnement je passe de Mardi = Noob des Macro (genre c'était du chinois !!) à Vendredi Low- des Macro :D
 
Je vous transmet ma relique :) un grand merci à vous deux Kiki29 et DJE69R et merci à tout les gens du net diffuse leur idée !!
 

Code :
  1. Sub Conversion_XXXXXXXXXXX()
  2. ' Remplacement des points par des virgules
  3. MsgBox "Remplacement des points par des virgules"
  4. Cells.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder _
  5.         :=xlByColumns, MatchCase:=False
  6. ' Suppression des informations complémentaires sur les Codes BSS (/Fxx /H etc)
  7. MsgBox "Suppression des informations complémentaires sur les Codes BSS"
  8. Rows("1:1" ).Select
  9.     Selection.Find(What:="CODPT", After:=ActiveCell, LookIn:=xlValues, _
  10.         LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
  11.         MatchCase:=False).Select
  12. Range(Selection, Selection.End(xlDown)).Select
  13. For Each c In Selection
  14.     c.Value = Left(c.Value, 10)
  15. Next c
  16. ' Ajout des guillemets pour chaque valeur
  17. MsgBox "Ajout des guillemets pour chaque valeur"
  18. Range("A1" ).Select
  19. Range(Selection, Selection.End(xlToRight)).Select
  20. Range(Selection, Selection.End(xlDown)).Select
  21. For Each c In Selection
  22.     c.Value = Chr(34) & c.Value & Chr(34)
  23. Next c
  24. ' Exportation du fichier au format TXT
  25. MsgBox "Exportation du fichier"
  26. Dim Ranges As Object, Line As Object, Cell As Object
  27. Dim StrTemp As String
  28. Dim Separateur As String
  29. Separateur = ";"
  30. Filename = Application.GetSaveAsFilename(Nom_Fichier, "Text Files (*.txt), *.txt" )
  31. Set Ranges = ActiveSheet.UsedRange
  32. Open Filename For Output As #1
  33. For Each Line In Ranges.Rows
  34. StrTemp = ""
  35. For Each Cell In Line.Cells
  36. StrTemp = StrTemp & CStr _
  37. (Cell.Text) & Separateur
  38. Next
  39. Print #1, StrTemp '= " "
  40. Next
  41. Close
  42. End Sub


 
Par contre j'ai rien compri à ton dernier message kiki29
Même si c'est moins important maintenant tu veux bien m'expliquer que je ne reste pas sur une interogation ^^

Reply

Marsh Posté le 09-04-2010 à 11:18:13    

Re,Utiliser systématiquement Option Explicit
2 utilitaires indispensables : http://www.oaltd.co.uk/Indenter/Default.htm
http://www.mztools.com/v3/mztools3.aspx
 
L'intérêt de CodeName c'est de permettre d'insérer, de déplacer des feuilles, de renommer les onglets sans avoir à retoucher au code VBA qui lui pointera toujours sur la feuille concernée
 
Sur un test grossier, la solution proposée semble plus rapide que la tienne


Message édité par kiki29 le 09-04-2010 à 11:19:51
Reply

Marsh Posté le 09-04-2010 à 11:30:23    

Merci bien je peux terminer cette semaine en paix maintenant :)
 
Il est certains qu'il doit exister des solutions beaucoup plus simples et rapides.
Mais ceci rempli mon cahier des charges :
- L'utilisateur ouvre excel avec ma macro
- Il ouvre le fichier texte de données à partir d'excel
- Il execute la macro
- Il insére le nouveau fichier dans le logiciel de traitement  
 
Je me pencherais sur ces utilitaires lorsque j'aurais du temps pour les améliorations du projet :)
 
Merci encore.
 
Cordialement,

Reply

Marsh Posté le 09-04-2010 à 11:32:24    

DIIIEEEUUUU comment fait-on pour mettre "[Résolu]" dans mon titre ?
(ça me fait toujours penser à ça quand je parle au modérateur mdr)

Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed