Sujet Précédent Sujet Suivant

[VBA EXCEL] - Modifier document texte

Fermé
BigBagProof - Modifié par jordane45 le 6/01/2015 à 17:11
f894009 Messages postés 17267 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 23 mars 2025 - 8 janv. 2015 à 11:49
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
A voir également:

2 réponses

Réponse 1 / 2
jordane45 Messages postés 38454 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 22 mars 2025 4 740
6 janv. 2015 à 17:15
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.

0
Réponse 2 / 2
BigBagProof
Modifié par jordane45 le 8/01/2015 à 01:52
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
0
BigBagProof
8 janv. 2015 à 10:23
Quelqu'un peut m'aider ?
0
jordane45 Messages postés 38454 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 22 mars 2025 4 740 > BigBagProof
8 janv. 2015 à 11:11
En 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
0
f894009 Messages postés 17267 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 23 mars 2025 1 713 > BigBagProof
8 janv. 2015 à 11:49
Bonjour,

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
0

Discussions similaires

Excel formule : savoir si une cellule contient partie texte
plunderer007 -
francois -

14 réponses