[VBA EXCEL] - Modifier document texte

Question

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

jordane45 · Answer

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.

BigBagProof · Answer

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

[VBA EXCEL] - Modifier document texte

2 réponses

Discussions similaires

Newsletters