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


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