[VBA EXCEL] - Modifier document texte

BigBagProof -  
Bonjour,

j'utilise vba sous office 2010 et je viens d'écrire une macro permettant de modifier un document texte et l'enregistrer par la suite (le doc est ouvert en excel)
le seul problème c'est qu'il y a des guillemets qui sont généré automatiquement sur chaque ligne du document final
j'ai essayé de parcourir le fichier et les supprimer mais bizarrement vba ne les détecte pas
si je fais left(ligne,1) ou right(ligne,1) je n'ai pas le caractère guillemet qui est renvoyé mais plutôt un caractère appartenant aux données que j'ai inséré dans le fichier

ci-dessous le code

merci
c'est cette partie qui pose problème 

Cells(i, "J") = Cells(i, "A") & ";" & _
            Cells(i, "B") & ";" & _
            Format(Cells(i, "C"), "000000") & ";" & _
            Cells(i, "D") & ";" & _
            Cells(i, "E") & ";" & _
            Cells(i, "F") & ";" & _
            Cells(i, "H")

cette chaîne se met automatiquement entre " " et je n'arrive pas à le faire disparaitre

2 réponses

  1.  jordane45 Modérateur
    Bonjour,

    cette chaîne se met automatiquement entre " "

    Où vois tu ces guillemets ? dans le document excel en cours ou une fois le document text généré ?

    une macro permettant de modifier un document texte

    De quel format est ton fichier text ? cela ressemble à du CSV.

    Es-tu sûr que le souci vient de ta ligne de code ?
    Décomposes là et ajoutes un petit debug pour savoir ce qu'elle te génère 
    Dim newString as String
newString = Cells(i, "A") & ";" & _
            Cells(i, "B") & ";" & _
            Format(Cells(i, "C"), "000000") & ";" & _
            Cells(i, "D") & ";" & _
            Cells(i, "E") & ";" & _
            Cells(i, "F") & ";" & _
            Cells(i, "H")
debug.print ("Ligne :" & i & " => " & newString)
Cells(i, "J") = newString


    A la limite.. postes nous un exemplaire de ton fichier excel (contenant ta macro) avec éventuellement quelques données tests pour que l'on puisse analyser ça.
    Tu peux le déposer sur le site : www.cijoint.com et nous coller le lien ici.

    1. BigBagProof
      Voici le fichier .txt d'entrée :

      CA;706101;070714;C;174,80;Produit;10;Ville1;HT
      CA;706101;150714;C;1093,80;Produit;10;Ville2;HT
      CA;706101;150714;C;1179,00;Produit;10;Ville1;HT
      CA;445715;070714;C;174,80;TVA Produit A 10%;10;Ville1;TVA
      CA;445715;150714;C;1093,80;TVA Produit A 10%;10;Ville2;TVA
      CA;445715;150714;C;1179,00;TVA Produit A 10%;10;Ville1;TVA

      voici ce que je reçois en sortie txt aussi :

      "CA;706101;070714;C;158,18;Produit;Ville1"
      "CA;706101;150714;C;993,64;Produit;Ville2"
      "CA;706101;150714;C;1071,82;Produit;Ville1"
      "CA;445715;070714;C;15,82;TVA Produit A 10%;Ville1"
      "CA;445715;150714;C;99,36;TVA Produit A 10%;Ville2"
      "CA;445715;150714;C;107,18;TVA Produit A 10%;Ville1"
      "CA;531000;070115;D;2446,00;Banque;SOCIETE1"

      Mon problème c'est les guillemets, le bizzare c'est que si je l'affiche en msgbox les guillemets n'apparaissent plus. 

      On Error Resume Next
Dim NomSociete As String
Dim Somme As Double
Dim Jour As String, Mois As String, Annee As String
Somme = 0
Jour = Format(Date, "dd")
Mois = Format(Date, "mm")
Annee = Format(Date, "yy")

    'adapté selon la nouvelle mise en page du fichier excel
    FolderSave = Cells(WorksheetFunction.Match("FolderSaveSociete1", Columns(2), 0), 3)
    
    'Ouvrir fichier à traiter
    If Not ThisWorkbook.Sheets(1).Range("C2").Value = "" Then
    ChDir (ThisWorkbook.Sheets(1).Range("C2").Value)
    End If
    chemin_bdxls = Application.GetOpenFilename("Fichier texte (*.txt), *.txt", , "Fichier d'export à traiter:")
    If chemin_bdxls = faux Then Exit Sub
    Workbooks.OpenText Filename:=chemin_bdxls, Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 4), _
        Array(2, 1), Array(3, 1))
            
    'Traiter les données
    NomSociete = Mid(chemin_bdxls, InStr(chemin_bdxls, "(") + 1, InStr(chemin_bdxls, ")") - InStr(chemin_bdxls, "(") - 1)
       'le nom de la societe est compris entre deux parenthèse
       'alors on dégage les caractères qui sont entre les parenthèses
       'du nom du fichier texte
    ThisWorkbook.Sheets(1).Range("A2").Value = NomSociete
    ThisWorkbook.Sheets(1).Range("C2").Value = ActiveWorkbook.Path & Application.PathSeparator
        lfin = WorksheetFunction.CountA(Columns(1))
    For i = 1 To lfin
        Cells(i, "E").Select
        If Cells(i, "I") = "TVA" Then
            'TVA
            HT = VBA.Val(Cells(i, "E")) / (1 + (VBA.Val(Cells(i, "G")) / 100))
            Cells(i, "E") = Format(CDec(VBA.Val(Cells(i, "E")) - HT), "0.00")
        Else
            'HT
            Cells(i, "E") = Format(CDec(VBA.Val(Cells(i, "E")) / (1 + (VBA.Val(Cells(i, "G")) / 100))), "0.00")
        End If
        Somme = Somme + (Cells(i, "E").Value) 'la somme à insérer à la fin du fichier
        Cells(i, "J") = Cells(i, "A") & ";" & _
            Cells(i, "B") & ";" & _
            Format(Cells(i, "C"), "000000") & ";" & _
            Cells(i, "D") & ";" & _
            Cells(i, "E") & ";" & _
            Cells(i, "F") & ";" & _
            Cells(i, "H")
    Next i
    'insertion de la dernière ligne
    Cells(i, "J") = "CA;531000;" & Jour & Mois & Annee & ";D;" & Format(Somme, "0.00") & ";Banque;" & NomSociete
    
    Columns("A:I").Delete
    
    'Enregistrer les modifs
    Dim ObjFso As Object
    Set ObjFso = CreateObject("Scripting.FileSystemObject")
    'objet permettant la manipulation des fichiers et repertoires
        If Not (Dir(chemin_bdxls & ".old") = "") Then
    ObjFso.copyfile chemin_bdxls, chemin_bdxls & ".old" & " " & Format(Date, "dd-mm-yyyy")
    Else
    ObjFso.copyfile chemin_bdxls, chemin_bdxls & ".old"
    End If
    'copie le fichier texte d'origine en le renommant .old
    'et s'il existe déjà, on rajoute la date à la fin
    'cette condition permet d'éviter d'écraser les anciens fichiers
    
    BDxls = ElementDeText(chemin_bdxls, "\", 1, "D")
    Workbooks(BDxls).Save 'As FolderSave & "\" & BDxls
    ActiveWorkbook.Close False
    
    If Err <> 0 Then
    MsgBox "une erreur s'est produite", vbExclamation + vbOKOnly, "Erreur"
        Else
    MsgBox "Traitement effectué avec succès", vbOKOnly, "Succès"
    End If
      1. BigBagProof
        Quelqu'un peut m'aider ?
      2. jordane45 Modérateur
        @BigBagProofEn ajoutant une étape supplémentaire à la fin de ton script pour supprimer les doubles quotes peut être... 

        On Error Resume Next
Dim NomSociete As String
Dim Somme As Double
Dim Jour As String, Mois As String, Annee As String
Somme = 0
Jour = Format(Date, "dd")
Mois = Format(Date, "mm")
Annee = Format(Date, "yy")

    'adapté selon la nouvelle mise en page du fichier excel
    FolderSave = Cells(WorksheetFunction.Match("FolderSaveSociete1", Columns(2), 0), 3)
    
    'Ouvrir fichier à traiter
    If Not ThisWorkbook.Sheets(1).Range("C2").Value = "" Then
    ChDir (ThisWorkbook.Sheets(1).Range("C2").Value)
    End If
    chemin_bdxls = Application.GetOpenFilename("Fichier texte (*.txt), *.txt", , "Fichier d'export à traiter:")
    If chemin_bdxls = faux Then Exit Sub
    Workbooks.OpenText Filename:=chemin_bdxls, Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 4), _
        Array(2, 1), Array(3, 1))
            
    'Traiter les données
    NomSociete = Mid(chemin_bdxls, InStr(chemin_bdxls, "(") + 1, InStr(chemin_bdxls, ")") - InStr(chemin_bdxls, "(") - 1)
       'le nom de la societe est compris entre deux parenthèse
       'alors on dégage les caractères qui sont entre les parenthèses
       'du nom du fichier texte
    ThisWorkbook.Sheets(1).Range("A2").Value = NomSociete
    ThisWorkbook.Sheets(1).Range("C2").Value = ActiveWorkbook.Path & Application.PathSeparator
        lfin = WorksheetFunction.CountA(Columns(1))
    For i = 1 To lfin
        Cells(i, "E").Select
        If Cells(i, "I") = "TVA" Then
            'TVA
            HT = VBA.Val(Cells(i, "E")) / (1 + (VBA.Val(Cells(i, "G")) / 100))
            Cells(i, "E") = Format(CDec(VBA.Val(Cells(i, "E")) - HT), "0.00")
        Else
            'HT
            Cells(i, "E") = Format(CDec(VBA.Val(Cells(i, "E")) / (1 + (VBA.Val(Cells(i, "G")) / 100))), "0.00")
        End If
        Somme = Somme + (Cells(i, "E").Value) 'la somme à insérer à la fin du fichier
        Cells(i, "J") = Cells(i, "A") & ";" & _
            Cells(i, "B") & ";" & _
            Format(Cells(i, "C"), "000000") & ";" & _
            Cells(i, "D") & ";" & _
            Cells(i, "E") & ";" & _
            Cells(i, "F") & ";" & _
            Cells(i, "H")
    Next i
    'insertion de la dernière ligne
    Cells(i, "J") = "CA;531000;" & Jour & Mois & Annee & ";D;" & Format(Somme, "0.00") & ";Banque;" & NomSociete
    
    Columns("A:I").Delete
    
    'Enregistrer les modifs
    Dim ObjFso As Object
    Set ObjFso = CreateObject("Scripting.FileSystemObject")
    'objet permettant la manipulation des fichiers et repertoires
        If Not (Dir(chemin_bdxls & ".old") = "") Then
    ObjFso.copyfile chemin_bdxls, chemin_bdxls & ".old" & " " & Format(Date, "dd-mm-yyyy")
    Else
    ObjFso.copyfile chemin_bdxls, chemin_bdxls & ".old"
    End If
    'copie le fichier texte d'origine en le renommant .old
    'et s'il existe déjà, on rajoute la date à la fin
    'cette condition permet d'éviter d'écraser les anciens fichiers
    
    BDxls = ElementDeText(chemin_bdxls, "\", 1, "D")
    Workbooks(BDxls).Save 'As FolderSave & "\" & BDxls
    ActiveWorkbook.Close False

' ------------------- Suppr des doubles quotes --------------------------
    Filename = StrReverse(chemin_bdxls)
    '~~> Read the entire file in 1 Go!
    Open Filename For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData = Split(MyData, vbCrLf)

    '~~> Get a free file handle
    filesize = FreeFile()

    '~~> Open your file
    Open Filename For Output As #filesize

    For i = LBound(strData) To UBound(strData)
        entireline = Replace(strData(i), """", "")
        '~~> Export Text
        Print #filesize, entireline
    Next i

    Close #filesize

  
    If Err <> 0 Then
    MsgBox "une erreur s'est produite", vbExclamation + vbOKOnly, "Erreur"
        Else
    MsgBox "Traitement effectué avec succès", vbOKOnly, "Succès"
    End If
      3. f894009
        @BigBagProofBonjour,

        c'est le format de votre fichier txt qui ressemble a un fichier csv qui pose probleme

        une solution possible

        remplacez cette ligne 
        Workbooks(BDxls).Save


        par celle-ci, mais l'extention sera .prn pas .txt 
        Workbooks(BDxls).SaveAs FileFormat:=xlTextPrinter

    Discussions similaires

    Excel formule : savoir si une cellule contient partie texte
    plunderer007

    14 réponses
    Modifier une annonce ou le prix sur Leboncoin sans payer
    BourrinOman83

    22 réponses
    Excel ajustement auto taille de la cellule
    Mélanie

    22 réponses