[VBA EXCEL] - Modifier document texte
Fermé
BigBagProof
-
Modifié par jordane45 le 6/01/2015 à 17:11
f894009 Messages postés 16904 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 18 mars 2023 - 8 janv. 2015 à 11:49
f894009 Messages postés 16904 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 18 mars 2023 - 8 janv. 2015 à 11:49
A voir également:
- [VBA EXCEL] - Modifier document texte
- Liste déroulante excel - Guide
- Formule excel - Guide
- Formule excel si contient texte alors texte ✓ - Forum Excel
- Dans le texte, un seul mot a réellement été écrit en lettres capitales (majuscules). quel est ce mot ? ✓ - Forum Word
- Signer un document word - Guide
2 réponses
jordane45
Messages postés
37253
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 mars 2023
4 551
6 janv. 2015 à 17:15
6 janv. 2015 à 17:15
Bonjour,
Où vois tu ces guillemets ? dans le document excel en cours ou une fois le document text généré ?
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
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.
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.
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.
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
jordane45
Messages postés
37253
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
17 mars 2023
4 551
>
BigBagProof
8 janv. 2015 à 11:11
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
f894009
Messages postés
16904
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 mars 2023
1 678
>
BigBagProof
8 janv. 2015 à 11:49
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
par celle-ci, mais l'extention sera .prn pas .txt
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