VBA Excel: Enregistrement d'un fichier csv avec ;

VBA Excel: Enregistrement d'un fichier csv avec ; - VB/VBA/VBS - Programmation

Marsh Posté le 04-09-2009 à 15:12:42    

Bonjour,
Après avoir parcouru plusieurs tutoriels, post de forum... je n'ai pas trouvé réponse à mon soucis.
J'ai développé une macro en VBA sous Excel qui à partir d'un fichier xls, me génère un même fichier en csv et effectue diverses tâches sur celui-ci.
Mon soucis est que lorsque j'ouvre après traitement mon fichier celui-ci contient des séparateurs "," mais il me faut des séparateurs ";". Le fichier doit-être lu après par une autre application, d'où la nécéssité du ";".
J'ai bien dans mon panneau de configuration=>option linguistiques le séparateur définis sur ";".
 
Ci-dessous mon code:

Code :
  1. Sub TraitementHistoriqueSeur()
  2.     Dim Var         As String
  3.     Dim sizeArray   As Integer
  4.     Dim i           As Integer
  5.     Dim dateVar     As String
  6.     Dim wb          As Workbook
  7.     Dim nameFile    As String
  8.    
  9.     '----------------------------------------
  10.     '------Sauvegarde du fichier en CSV------
  11.     '----------------------------------------
  12.     Set wb = ActiveWorkbook
  13.     wb.Activate
  14.    
  15.     If DossierExiste("C:\Documents and Settings\All Users\Bureau\GENAUTO_SEUR_NEW_FILES_CSV" ) = False Then
  16.         MkDir "C:\Documents and Settings\All Users\Bureau\GENAUTO_SEUR_NEW_FILES_CSV"
  17.         ChDir "C:\Documents and Settings\All Users\Bureau\GENAUTO_SEUR_NEW_FILES_CSV"
  18.     End If
  19.    
  20.     ActiveWorkbook.SaveAs Filename:= _
  21.         "C:\Documents and Settings\All Users\Bureau\GENAUTO_SEUR_NEW_FILES_CSV/" & Mid(wb.Name, 1, 21) & ".csv" _
  22.        , FileFormat:=xlCSV, CreateBackup:=False, local:=True
  23.      
  24.     With Application
  25.         .DecimalSeparator = "."
  26.     End With
  28.     '----------------------------------------
  29.     '-Fermeture du classeur courant & Autres-
  30.     '----------------------------------------
  31.     Columns("D:D" ).Select
  32.     Selection.NumberFormat = "General"
  33.        
  34.     ActiveWorkbook.Close savechanges:=True
  36. EndSub


Si quelque peut m'aider...  :??:  
Merci


Message édité par jonath88 le 04-09-2009 à 15:16:05
Reply

Marsh Posté le 04-09-2009 à 15:12:42   

Reply

Marsh Posté le 08-09-2009 à 16:22:29    

Bien le bonjour
 
Le plus simple c'est de le réouvrir en texte, et de remplacer la virgule par un point virgule.
 
Sinon il y a cette méthode :

Code :
  1. Sub jonath88()
  2.     Dim Plage As Object, LigneFeuille As Object, Cellule As Object, Ligne As String, Qu As Integer, x As Integer
  3.  
  4.     Separateur = ";"
  5.     Set Plage = ActiveSheet.UsedRange
  6.    
  7.     Qu = MsgBox("Intégrer la 1ere ligne ? (noms des champs) ?", vbYesNo, "Question" )
  8.     If Qu = vbYes Then
  9.         Qu = 1
  10.     Else
  11.         Qu = 0
  12.     End If
  13.    
  14.     Open "C:\jonath88.csv" For Output As #1
  15.    
  16.    
  17.     For Each LigneFeuille In Plage.Rows
  18.         Ligne = ""
  19.         If Qu <> 0 Then
  20.             For Each Cellule In LigneFeuille.Cells
  21.                 Ligne = Ligne & CStr(Cellule.Text) & Separateur
  22.             Next
  23.             Print #1, Ligne
  24.         End If
  25.         Qu = 1
  26.     Next
  27.    
  28.     Close
  29. End Sub


 
Cordialement

Message cité 1 fois
Message édité par SuppotDeSaTante le 08-09-2009 à 16:25:39

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

Marsh Posté le 08-09-2009 à 17:33:08    

Merci,  :)  
Le hic est que je dois appliquer la macro sur 500 fichiers de façon régulière, donc la première solution me semble assez difficile. Je test la deuxième.


Message édité par jonath88 le 08-09-2009 à 17:33:20
Reply

Marsh Posté le 08-09-2009 à 17:58:18    

SuppotDeSaTante a écrit :

Bien le bonjour
 
Le plus simple c'est de le réouvrir en texte, et de remplacer la virgule par un point virgule.
 
Sinon il y a cette méthode :

Code :
  1. Sub jonath88()
  2.     Dim Plage As Object, LigneFeuille As Object, Cellule As Object, Ligne As String, Qu As Integer, x As Integer
  3.  
  4.     Separateur = ";"
  5.     Set Plage = ActiveSheet.UsedRange
  6.    
  7.     Qu = MsgBox("Intégrer la 1ere ligne ? (noms des champs) ?", vbYesNo, "Question" )
  8.     If Qu = vbYes Then
  9.         Qu = 1
  10.     Else
  11.         Qu = 0
  12.     End If
  13.    
  14.     Open "C:\jonath88.csv" For Output As #1
  15.    
  16.    
  17.     For Each LigneFeuille In Plage.Rows
  18.         Ligne = ""
  19.         If Qu <> 0 Then
  20.             For Each Cellule In LigneFeuille.Cells
  21.                 Ligne = Ligne & CStr(Cellule.Text) & Separateur
  22.             Next
  23.             Print #1, Ligne
  24.         End If
  25.         Qu = 1
  26.     Next
  27.    
  28.     Close
  29. End Sub


 
Cordialement


 
Dans mon cas cette méthode fonctionne diffillement et me provoques dans erreurs pour certaines cellules...
Mais normalement lorsqu'on crée un csv on doit pouvoir lui définir le séparateur en ";"?
Y a t il un problème avec Excel? Je travail sur une version 2003?
 
Ou alors quelqu'un a-til une solution?  :??:

Reply

Marsh Posté le 08-09-2009 à 19:12:05    

Salut, afin de tester plus facilement j'ai modifié le code et celui-ci fonctionne correctement, à toi de le réadapter à ton contexte


Option Explicit
 
Sub TraitementHistoriqueSeur()
Dim sNomWkb As String, sNomCSV As String
    sNomWkb = ActiveWorkbook.Name
    sNomCSV = Left$(sNomWkb, InStr(sNomWkb, "." ) - 1)
     
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & sNomCSV & ".csv", FileFormat:=xlCSV, Local:=True
     
    With Application
        .DecimalSeparator = "."
    End With
 
    Columns("D:D" ).NumberFormat = "General"
 
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & sNomWkb, FileFormat:=xlNormal
    Application.DisplayAlerts = True
End Sub


 
Plutot que MkDir et tout le bazar autour


Option Explicit
 
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
 
' Pour valeur retournée dans Rep
' Voir http://msdn.microsoft.com/en-us/library/bb762131(VS.85).aspx
' et   http://msdn.microsoft.com/en-us/library/ms681381(VS.85).aspx
Private Sub CreationDossier(sDossier As String)
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0& )
End Sub
 
Sub Test()
Dim sDossier As String
    sDossier = "D:\repA\repB\repC\repD\repE\repF"
    CreationDossier sDossier
End Sub


Message édité par kiki29 le 08-09-2009 à 21:06:53
Reply

Sujets relatifs:

Leave a Replay

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