Recuperer les numeros de ligne
Résolu
cs_audrey08
Messages postés
25
Date d'inscription
lundi 4 avril 2005
Statut
Membre
Dernière intervention
25 mai 2005
-
26 avril 2005 à 11:03
Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 - 27 avril 2005 à 14:36
Gobillot Messages postés 3140 Date d'inscription vendredi 14 mai 2004 Statut Membre Dernière intervention 11 mars 2019 - 27 avril 2005 à 14:36
A voir également:
- Recuperer les numeros de ligne
- Récupérer données json (javascript) - Conseils pratiques -Javascript
- Saut de ligne c# - Forum C# / .NET
- Recuperer miniature youtube ✓ - Forum PHP
- Saut de ligne \n - Forum PHP
- Dérivée en ligne - Forum Delphi / Pascal
17 réponses
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
27 avril 2005 à 12:45
27 avril 2005 à 12:45
Dim Mypath As String
Dim Myfile As String
Dim Myname As String
Dim Ligne As String
Dim Nom_fichier As String
Dim tmp As String
Dim Fichier As String
Dim i As Integer
Dim source As Integer
Dim dest As Integer
Dim cpt As Long
Dim num_ligne1 As Long
Dim num_ligne2 As Long
Mypath = "C:\Documents and Settings\boudsocq\Mes documents\vb_developpement\gestion_documentaire"
Myfile = Dir(Mypath & "DMS*.doc")
Do While Myfile <> ""
i = i + 1
cpt = 0
dest = FreeFile
Open Mypath & "resultat" & i & ".txt" For Output As #dest
source = FreeFile
Myname = Mypath & Myfile
Open Myname For Input As #source
While Not EOF(source)
Line Input #source, Ligne
' If InStr(Ligne, "PAGE : 1") Then num_ligne1 = cpt
' If InStr(Ligne, "PAGE : 2") Then num_ligne2 = cpt
If InStr(Ligne, "PAGE :") Then cpt = 0
cpt = cpt + 1
' remplacement des caractères spéciaux
Ligne = Replace(Ligne, "{", "é")
Ligne = Replace(Ligne, "}", "è")
Ligne = Replace(Ligne, "@", "à")
Ligne = Replace(Ligne, "¢", "°")
' suppression des 3 premières lignes du fichier
If cpt > 3 And cpt < 7 Then
If cpt = 4 Then
Nom_fichier = Mid$(Ligne, 66, Len(Ligne) - 69)
Ligne = Replace(Ligne, "Applicable à", " ")
End If
' écriture du résultat final dans le fichier destinataire
Print #dest, Ligne
End If
If cpt > 10 Then
' remplace le 0 du début de ligne par un saut de ligne
If Left$(Ligne, 2) = "0 " Then
Ligne = Replace(Ligne, "0 ", vbCrLf)
End If
' supprime le "0" de certaines lignes
If Left$(Ligne, 24) = "0Liaisons interdocuments" Then
Ligne = Replace(Ligne, "0", " ")
End If
If Left$(Ligne, 23) = "0Destinataires document" Then
Ligne = Replace(Ligne, "0", " ")
End If
If Left$(Ligne, 10) = "0Rédacteur" Then
Ligne = Replace(Ligne, "0", " ")
End If
' et j'en fait quoi, je les écris ?
Print #dest, Ligne
End If
Wend
Close #source
' Kill Myname
Close #dest
Myfile = Dir
Loop
Daniel
Dim Myfile As String
Dim Myname As String
Dim Ligne As String
Dim Nom_fichier As String
Dim tmp As String
Dim Fichier As String
Dim i As Integer
Dim source As Integer
Dim dest As Integer
Dim cpt As Long
Dim num_ligne1 As Long
Dim num_ligne2 As Long
Mypath = "C:\Documents and Settings\boudsocq\Mes documents\vb_developpement\gestion_documentaire"
Myfile = Dir(Mypath & "DMS*.doc")
Do While Myfile <> ""
i = i + 1
cpt = 0
dest = FreeFile
Open Mypath & "resultat" & i & ".txt" For Output As #dest
source = FreeFile
Myname = Mypath & Myfile
Open Myname For Input As #source
While Not EOF(source)
Line Input #source, Ligne
' If InStr(Ligne, "PAGE : 1") Then num_ligne1 = cpt
' If InStr(Ligne, "PAGE : 2") Then num_ligne2 = cpt
If InStr(Ligne, "PAGE :") Then cpt = 0
cpt = cpt + 1
' remplacement des caractères spéciaux
Ligne = Replace(Ligne, "{", "é")
Ligne = Replace(Ligne, "}", "è")
Ligne = Replace(Ligne, "@", "à")
Ligne = Replace(Ligne, "¢", "°")
' suppression des 3 premières lignes du fichier
If cpt > 3 And cpt < 7 Then
If cpt = 4 Then
Nom_fichier = Mid$(Ligne, 66, Len(Ligne) - 69)
Ligne = Replace(Ligne, "Applicable à", " ")
End If
' écriture du résultat final dans le fichier destinataire
Print #dest, Ligne
End If
If cpt > 10 Then
' remplace le 0 du début de ligne par un saut de ligne
If Left$(Ligne, 2) = "0 " Then
Ligne = Replace(Ligne, "0 ", vbCrLf)
End If
' supprime le "0" de certaines lignes
If Left$(Ligne, 24) = "0Liaisons interdocuments" Then
Ligne = Replace(Ligne, "0", " ")
End If
If Left$(Ligne, 23) = "0Destinataires document" Then
Ligne = Replace(Ligne, "0", " ")
End If
If Left$(Ligne, 10) = "0Rédacteur" Then
Ligne = Replace(Ligne, "0", " ")
End If
' et j'en fait quoi, je les écris ?
Print #dest, Ligne
End If
Wend
Close #source
' Kill Myname
Close #dest
Myfile = Dir
Loop
Daniel
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
27 avril 2005 à 14:36
27 avril 2005 à 14:36
je rajoute:
Dim Page As Integer
Dim Copie As Boolean
Do While Myfile <> ""
Copie = True
- - - - - - - -
While Not EOF(source)
Line Input #source, Ligne
If InStr(Ligne, "PAGE :") Then
cpt = 0
Page = Val(Trim$(Right$(Ligne, 3)))
End If
If cpt > 3 And cpt < 7 Then
If cpt = 4 Then
Nom_fichier = Mid$(Ligne, 66, Len(Ligne) - 69)
Ligne = Replace(Ligne, "Applicable à", " ")
End If
' écriture du résultat final dans le fichier destinataire
If Page = 1 Then Print #dest, Ligne
End If
If cpt > 10 Then
' remplace le 0 du début de ligne par un saut de ligne
If Left$(Ligne, 2) = "0 " Then
Ligne = Replace(Ligne, "0 ", vbCrLf)
End If
' détecte la Ligne du bas
If Left$(Ligne, 2) = " _" Then
Copie = False
End If
' If Left$(Ligne, 24) = "0Liaisons interdocuments" Then
' Copie = False
' End If
' If Left$(Ligne, 23) = "0Destinataires document" Then
' Copie = False
' End If
If Left$(Ligne, 10) = "0Rédacteur" Then
Ligne = Replace(Ligne, "0", " ")
Copie = True
Print #dest, vbCrLf;
End If
If Copie Then Print #dest, Ligne
End If
Daniel
Dim Page As Integer
Dim Copie As Boolean
Do While Myfile <> ""
Copie = True
- - - - - - - -
While Not EOF(source)
Line Input #source, Ligne
If InStr(Ligne, "PAGE :") Then
cpt = 0
Page = Val(Trim$(Right$(Ligne, 3)))
End If
If cpt > 3 And cpt < 7 Then
If cpt = 4 Then
Nom_fichier = Mid$(Ligne, 66, Len(Ligne) - 69)
Ligne = Replace(Ligne, "Applicable à", " ")
End If
' écriture du résultat final dans le fichier destinataire
If Page = 1 Then Print #dest, Ligne
End If
If cpt > 10 Then
' remplace le 0 du début de ligne par un saut de ligne
If Left$(Ligne, 2) = "0 " Then
Ligne = Replace(Ligne, "0 ", vbCrLf)
End If
' détecte la Ligne du bas
If Left$(Ligne, 2) = " _" Then
Copie = False
End If
' If Left$(Ligne, 24) = "0Liaisons interdocuments" Then
' Copie = False
' End If
' If Left$(Ligne, 23) = "0Destinataires document" Then
' Copie = False
' End If
If Left$(Ligne, 10) = "0Rédacteur" Then
Ligne = Replace(Ligne, "0", " ")
Copie = True
Print #dest, vbCrLf;
End If
If Copie Then Print #dest, Ligne
End If
Daniel
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
26 avril 2005 à 11:13
26 avril 2005 à 11:13
Dim Ligne As String
Dim numero As Long
open fichier1 for input #1
open fichier2 for output #2
While not EOF (1)
Line input #1, Ligne
numero = numero + 1
if numero < premier or numero > dernier then
print #2, Ligne
end if
Wend
close #2
close #1
il y a peut être des erreurs parce que j'ai pas testé, mais c'est le principe on lit le fichier et on récris les lignes sauf les supprimées.
Daniel
Dim numero As Long
open fichier1 for input #1
open fichier2 for output #2
While not EOF (1)
Line input #1, Ligne
numero = numero + 1
if numero < premier or numero > dernier then
print #2, Ligne
end if
Wend
close #2
close #1
il y a peut être des erreurs parce que j'ai pas testé, mais c'est le principe on lit le fichier et on récris les lignes sauf les supprimées.
Daniel
cs_audrey08
Messages postés
25
Date d'inscription
lundi 4 avril 2005
Statut
Membre
Dernière intervention
25 mai 2005
26 avril 2005 à 11:17
26 avril 2005 à 11:17
ok mais mon problème c que je dois recuperer le numéro de la ligne et ca je ne sais pas comment faire. SI tu veux j'ai dans une phrase l'expression "liaison interdocument" et dans un autre "rédacteur". Je dois recuperer le numéro de ces 2 lignes et après supprimer les lignes comprises entre ces deux phrases.Merci pour ton aide
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
26 avril 2005 à 11:31
26 avril 2005 à 11:31
Dim Ligne As String
Dim copie As Boolean
Open fichier1 For Input As #1
Open fichier2 For Output As #2
copie = True
While Not EOF(1)
Line Input #1, Ligne
If copie Then Print #2, Ligne
If copie Then
If InStr(1, Ligne, "liaison interdocument", vbTextCompare) > 0 Then copie = False
Else
If InStr(1, Ligne, "rédacteur", vbTextCompare) > 0 Then copie = True
End If
Wend
Close #2
Close #1
j'espère avoir compris cette fois.
Daniel
Dim copie As Boolean
Open fichier1 For Input As #1
Open fichier2 For Output As #2
copie = True
While Not EOF(1)
Line Input #1, Ligne
If copie Then Print #2, Ligne
If copie Then
If InStr(1, Ligne, "liaison interdocument", vbTextCompare) > 0 Then copie = False
Else
If InStr(1, Ligne, "rédacteur", vbTextCompare) > 0 Then copie = True
End If
Wend
Close #2
Close #1
j'espère avoir compris cette fois.
Daniel
econs
Messages postés
4030
Date d'inscription
mardi 13 mai 2003
Statut
Membre
Dernière intervention
23 décembre 2008
24
26 avril 2005 à 11:32
26 avril 2005 à 11:32
complète le code de Gobillot avec ceci
Dim compteurLignes As Long
[...]
compteurLignes=1
While not EOF (1)
Line input #1, Ligne
numero = numero + 1
if numero < premier or numero > dernier then
print #2, Ligne
end if
MsgBox "ligne courante : " & compteurLignes & " valeur : " & Ligne
compteurLignes=compteurLignes+1
Wend
Manu
-------------------------------------------
Une question bien posée, c'est une chance de réponse bien adaptée.
Dim compteurLignes As Long
[...]
compteurLignes=1
While not EOF (1)
Line input #1, Ligne
numero = numero + 1
if numero < premier or numero > dernier then
print #2, Ligne
end if
MsgBox "ligne courante : " & compteurLignes & " valeur : " & Ligne
compteurLignes=compteurLignes+1
Wend
Manu
-------------------------------------------
Une question bien posée, c'est une chance de réponse bien adaptée.
cs_audrey08
Messages postés
25
Date d'inscription
lundi 4 avril 2005
Statut
Membre
Dernière intervention
25 mai 2005
26 avril 2005 à 11:42
26 avril 2005 à 11:42
je suis désolée mais ca ne marcha pas. A mon avis c moi qui m'explique mal. Je vais essayer de vous expliquer mon travail à nouveau.
Voilà je récupère des fichiers word que je dois traiter.
De ces fichiers qui ont tous la même forme je dois leur appliquer certains traitements.
Notamment, je dois supprimer une partie du texte dont je connais les extrémités cad q je connais le début et la fin du paragraphe. Mon problème survient alors. Je n'arrive pas à supprimer cette partie. Est ce plus clair pour vous. Si oui pouvez m'aider. Merci
Voilà je récupère des fichiers word que je dois traiter.
De ces fichiers qui ont tous la même forme je dois leur appliquer certains traitements.
Notamment, je dois supprimer une partie du texte dont je connais les extrémités cad q je connais le début et la fin du paragraphe. Mon problème survient alors. Je n'arrive pas à supprimer cette partie. Est ce plus clair pour vous. Si oui pouvez m'aider. Merci
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
26 avril 2005 à 12:10
26 avril 2005 à 12:10
Dim Buffer As String
Dim chaine1 As String
Dim chaine2 As String
Dim temp As String
Dim debut As Integer
Dim fin As Integer
chaine1 = "liaison interdocument"
chaine2 = "rédacteur"
Open fichier1 For Binary As #1
Buffer = Space$(LOF(1))
Get #1, , Buffer
Close #1
debut = InStr(1, Buffer, chaine1, vbTextCompare)
fin = InStr(1, Buffer, chaine2, vbTextCompare)
If debut > 0 And fin > 0 Then
' modifier debut ou fin suivant le cas
debut = debut + Len(chaine1)
' fin = fin + Len(chaine2)
temp = Mid$(Buffer, debut, fin - debut)
Buffer = Replace(Buffer, temp, "")
Open fichier2 For Binary As #2
Put #2, , Buffer
Close #2
Else
MsgBox "chaîne(s) non trouvée(s)"
End If
je suis pas sur qu'on puisse modifier les fichiers doc comme ça.
Daniel
Dim chaine1 As String
Dim chaine2 As String
Dim temp As String
Dim debut As Integer
Dim fin As Integer
chaine1 = "liaison interdocument"
chaine2 = "rédacteur"
Open fichier1 For Binary As #1
Buffer = Space$(LOF(1))
Get #1, , Buffer
Close #1
debut = InStr(1, Buffer, chaine1, vbTextCompare)
fin = InStr(1, Buffer, chaine2, vbTextCompare)
If debut > 0 And fin > 0 Then
' modifier debut ou fin suivant le cas
debut = debut + Len(chaine1)
' fin = fin + Len(chaine2)
temp = Mid$(Buffer, debut, fin - debut)
Buffer = Replace(Buffer, temp, "")
Open fichier2 For Binary As #2
Put #2, , Buffer
Close #2
Else
MsgBox "chaîne(s) non trouvée(s)"
End If
je suis pas sur qu'on puisse modifier les fichiers doc comme ça.
Daniel
cs_audrey08
Messages postés
25
Date d'inscription
lundi 4 avril 2005
Statut
Membre
Dernière intervention
25 mai 2005
26 avril 2005 à 13:30
26 avril 2005 à 13:30
en fait ce n'est pas modifier le texte que je veux faire c suivant le texte je veux recuperer le numéro de la ligne correspondante et ensuite je veux supprimer les lignes comprisses entres ces 2 lignes. Merci pour votre aide
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
26 avril 2005 à 13:44
26 avril 2005 à 13:44
il n'y a pas de lignes dans un fichier doc, c'est pas un fichier texte
enfin j'ai supposé que c'était un fichier ".doc" puisque venant de Word
et les numéros de lignes c'est toi qui les as mis ?
regarde un peu avec MsgBox temp si ton texte a été trouvé et comment il se présente
Daniel
enfin j'ai supposé que c'était un fichier ".doc" puisque venant de Word
et les numéros de lignes c'est toi qui les as mis ?
regarde un peu avec MsgBox temp si ton texte a été trouvé et comment il se présente
Daniel
cs_audrey08
Messages postés
25
Date d'inscription
lundi 4 avril 2005
Statut
Membre
Dernière intervention
25 mai 2005
26 avril 2005 à 14:02
26 avril 2005 à 14:02
pour les lignes j'ai fait un compteur donc voila.
cs_audrey08
Messages postés
25
Date d'inscription
lundi 4 avril 2005
Statut
Membre
Dernière intervention
25 mai 2005
26 avril 2005 à 15:19
26 avril 2005 à 15:19
alors comment puis je faire pour supprimer certaines lignes de mon fichier? Merci pour tout
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
26 avril 2005 à 15:30
26 avril 2005 à 15:30
faudrait un exemple de ton fichier pour savoir comment sont fait les lignes et le numérotage.
Daniel
Daniel
cs_audrey08
Messages postés
25
Date d'inscription
lundi 4 avril 2005
Statut
Membre
Dernière intervention
25 mai 2005
26 avril 2005 à 15:32
26 avril 2005 à 15:32
voici mon code ainsi qu'un de mes fichiers.
fichier:
VS/ITR-020 001<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" />
APPROVISIONNEMENT DES POSTES DE VS EN PÂTES Date appli
21/12/1998
||| SEUL LE DOCUMENT ECRAN CORRESPONDANT FAIT FOI |||
________________________________________________________________________________
»1-Objet domaine d'application.
Définir les opérations a suivre pour alimenter la ligne en pâtes
dans le cadre d'une impression.
»2-Documents de référence
Consignes de sécurité
Suivi de bennes (VM / ENR-070-)
»3-Définitions / Abréviations
néant
»4-Responsabilités
VS/ORG-104- (Définition de fonction Ravitailleur)
VS/ORG-105- (Définition de fonction Imprimeur Pré-Enduction)
VS/ORG-106- (Définition de fonction Imprimeur)
»5-Mode opératoire
Avant toute intervention la personne doit être munie des protections
individuelles, une formation et information à la sécurité doit être faite.
(voir le chef d'équipe ou l'agent de maitrise). un rappel des principales
consignes de sécurité est affiché au poste de travail .
Informer son CL ou AM de toute anomalie ( machine, produit, sécurité)
Utiliser le transpalette électrique, pour aller chercher la ou les bennes
pâtes suivant le type de dessin en cours de réalisation sur la chaîne
Prendre les bennes se trouvant dans le couloir côté mélange, le long
du mur (VM/ENR-070-) par ordre chronologique de numérotation et les
amener à leur poste d'utilisation.
Utiliser la petite pompe au poste de préenduction pour transvaser dans
la 1°benne qui a été mise en place au début de fabrication, afin
d'homogénéiser la viscosité et la couleur.
»6-Enregistrement
néant
________________________________________________________________________________
0Liaisons interdocuments
VS/ORG-104
VM/ENR-070
VS/ORG-105
VS/ORG-106
________________________________________________________________________________
0Destinataires document
TOUS SERVICES
Rédacteur : FRANCK JEAN PIERRE
Vérificateur : GAUDRY DIDIER
Approbateur : PREVOT FABRICE
code:
Sub main()
'déclarations des variables
Dim Mypath, Myfile, Myname
Dim source, dest As Integer
Dim ligne As String
Dim cpt As Long
Dim nom_fichier, tmp As String
Dim Fichier As String
Mypath = "C:\Documents and Settings\boudsocq\Mes documents\vb_developpement\gestion_documentaire"
Myfile = Dir("C:\Documents and Settings\boudsocq\Mes documents\vb_developpement\gestion_documentaire\DMS*.doc")
Myname = Mypath & Myfile
For i = 0 To Len(Mypath)
Do While Myfile <> ""
i = i + 1
cpt = 0
dest = FreeFile
Open "C:\Documents and Settings\boudsocq\Mes documents\vb_developpement\gestion_documentaire\resultat" & i & ".doc" For Output As #dest
source = FreeFile
Open Myname For Input As #source
While Not EOF(source)
Line Input #source, ligne
cpt = cpt + 1
'remplacement des caractères spéciaux
ligne = Replace(ligne, "{", "é")
ligne = Replace(ligne, "}", "è")
ligne = Replace(ligne, "@", "à")
ligne = Replace(ligne, "¢", "°")
'suppression des 3 premières lignes du fichier
If cpt > 3 And cpt < 7 Then
If cpt = 4 Then
tmp = Left(ligne, Len(ligne) - 4)
nom_fichier = Right(tmp, Len(tmp) - 65)
End If
ligne = Replace(ligne, "Applicable à", " ")
'ecriture du résultat final dans le fichier destinataire
Print #dest, ligne
End If
If InStr(ligne, "1FORBO") Then
num_ligne = cpt
End If
If cpt > 10 Then
'remplace le 0 du début de ligne par un saut de ligne
If InStr(1, ligne, "0 ") Then
ligne = Replace(ligne, "0 ", vbCrLf)
End If
If InStr(ligne, "0Rédacteur ") Then
ligne = Replace(ligne, "0", " ")
End If
End If
Wend
Close #source
'Kill Myname
Close #dest
Myfile = Dir
Myname = Mypath & Myfile
Loop
'renommer fichier
Next i
End Sub
fichier:
VS/ITR-020 001<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" />
APPROVISIONNEMENT DES POSTES DE VS EN PÂTES Date appli
21/12/1998
||| SEUL LE DOCUMENT ECRAN CORRESPONDANT FAIT FOI |||
________________________________________________________________________________
»1-Objet domaine d'application.
Définir les opérations a suivre pour alimenter la ligne en pâtes
dans le cadre d'une impression.
»2-Documents de référence
Consignes de sécurité
Suivi de bennes (VM / ENR-070-)
»3-Définitions / Abréviations
néant
»4-Responsabilités
VS/ORG-104- (Définition de fonction Ravitailleur)
VS/ORG-105- (Définition de fonction Imprimeur Pré-Enduction)
VS/ORG-106- (Définition de fonction Imprimeur)
»5-Mode opératoire
Avant toute intervention la personne doit être munie des protections
individuelles, une formation et information à la sécurité doit être faite.
(voir le chef d'équipe ou l'agent de maitrise). un rappel des principales
consignes de sécurité est affiché au poste de travail .
Informer son CL ou AM de toute anomalie ( machine, produit, sécurité)
Utiliser le transpalette électrique, pour aller chercher la ou les bennes
pâtes suivant le type de dessin en cours de réalisation sur la chaîne
Prendre les bennes se trouvant dans le couloir côté mélange, le long
du mur (VM/ENR-070-) par ordre chronologique de numérotation et les
amener à leur poste d'utilisation.
Utiliser la petite pompe au poste de préenduction pour transvaser dans
la 1°benne qui a été mise en place au début de fabrication, afin
d'homogénéiser la viscosité et la couleur.
»6-Enregistrement
néant
________________________________________________________________________________
0Liaisons interdocuments
VS/ORG-104
VM/ENR-070
VS/ORG-105
VS/ORG-106
________________________________________________________________________________
0Destinataires document
TOUS SERVICES
Rédacteur : FRANCK JEAN PIERRE
Vérificateur : GAUDRY DIDIER
Approbateur : PREVOT FABRICE
code:
Sub main()
'déclarations des variables
Dim Mypath, Myfile, Myname
Dim source, dest As Integer
Dim ligne As String
Dim cpt As Long
Dim nom_fichier, tmp As String
Dim Fichier As String
Mypath = "C:\Documents and Settings\boudsocq\Mes documents\vb_developpement\gestion_documentaire"
Myfile = Dir("C:\Documents and Settings\boudsocq\Mes documents\vb_developpement\gestion_documentaire\DMS*.doc")
Myname = Mypath & Myfile
For i = 0 To Len(Mypath)
Do While Myfile <> ""
i = i + 1
cpt = 0
dest = FreeFile
Open "C:\Documents and Settings\boudsocq\Mes documents\vb_developpement\gestion_documentaire\resultat" & i & ".doc" For Output As #dest
source = FreeFile
Open Myname For Input As #source
While Not EOF(source)
Line Input #source, ligne
cpt = cpt + 1
'remplacement des caractères spéciaux
ligne = Replace(ligne, "{", "é")
ligne = Replace(ligne, "}", "è")
ligne = Replace(ligne, "@", "à")
ligne = Replace(ligne, "¢", "°")
'suppression des 3 premières lignes du fichier
If cpt > 3 And cpt < 7 Then
If cpt = 4 Then
tmp = Left(ligne, Len(ligne) - 4)
nom_fichier = Right(tmp, Len(tmp) - 65)
End If
ligne = Replace(ligne, "Applicable à", " ")
'ecriture du résultat final dans le fichier destinataire
Print #dest, ligne
End If
If InStr(ligne, "1FORBO") Then
num_ligne = cpt
End If
If cpt > 10 Then
'remplace le 0 du début de ligne par un saut de ligne
If InStr(1, ligne, "0 ") Then
ligne = Replace(ligne, "0 ", vbCrLf)
End If
If InStr(ligne, "0Rédacteur ") Then
ligne = Replace(ligne, "0", " ")
End If
End If
Wend
Close #source
'Kill Myname
Close #dest
Myfile = Dir
Myname = Mypath & Myfile
Loop
'renommer fichier
Next i
End Sub
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
26 avril 2005 à 17:43
26 avril 2005 à 17:43
excuses moi j'ai été absent un moment...
je reviens à mon problème de fichier "doc", j'ai recopié ton fichier en "txt", ensuite avec Word je l'ai sauvé en "doc", taille= plus de 23000 au lieu des 2240 d'origine, impossible de traiter ce fichier avec des Line Input !!!
donc je suppose que tes fichiers "doc" sont des fichiers "txt" mal nommés.
je reprends ton code, je refait toutes les définitions:
Dim Mypath As String
Dim Myfile As String
Dim Myname As String
Dim Ligne As String
Dim Nom_fichier As String
Dim tmp As String
Dim Fichier As String
Dim i As Integer
Dim source As Integer
Dim dest As Integer
Dim cpt As Long
Dim num_ligne As Long
c'est quoi cette ligne ? pour moi elle est invraisemblable:
For i = 0 To Len(Mypath)
autant utiliser Mypath, ça évite d'écrire des kilomètres
Mypath = "C:\Documents and Settings\boudsocq\Mes documents\vb_developpement\gestion_documentaire"
Myfile = Dir(Mypath & "DMS*.doc")
Myname = Mypath & Myfile
Myname = Mypath & Myfile
je met le test à part pour la 4éme Ligne (entre parenthèses, j'ai eu du mal avec lignes à blanc, il y en avait partout)
If cpt = 4 Then
Nom_fichier = Mid$(tmp, 66, Len(Ligne) - 69)
End If
pas trouvé nulle part ?
Ligne = Replace(Ligne, "Applicable à", " ")
pour l'instant j'en suis là, avant de continuer, dis moi si je suis sur la bonne voix, j'ai bien retrouvé le nom_fichier "VS/ITR-020"
Daniel
je reviens à mon problème de fichier "doc", j'ai recopié ton fichier en "txt", ensuite avec Word je l'ai sauvé en "doc", taille= plus de 23000 au lieu des 2240 d'origine, impossible de traiter ce fichier avec des Line Input !!!
donc je suppose que tes fichiers "doc" sont des fichiers "txt" mal nommés.
je reprends ton code, je refait toutes les définitions:
Dim Mypath As String
Dim Myfile As String
Dim Myname As String
Dim Ligne As String
Dim Nom_fichier As String
Dim tmp As String
Dim Fichier As String
Dim i As Integer
Dim source As Integer
Dim dest As Integer
Dim cpt As Long
Dim num_ligne As Long
c'est quoi cette ligne ? pour moi elle est invraisemblable:
For i = 0 To Len(Mypath)
autant utiliser Mypath, ça évite d'écrire des kilomètres
Mypath = "C:\Documents and Settings\boudsocq\Mes documents\vb_developpement\gestion_documentaire"
Myfile = Dir(Mypath & "DMS*.doc")
Myname = Mypath & Myfile
Myname = Mypath & Myfile
je met le test à part pour la 4éme Ligne (entre parenthèses, j'ai eu du mal avec lignes à blanc, il y en avait partout)
If cpt = 4 Then
Nom_fichier = Mid$(tmp, 66, Len(Ligne) - 69)
End If
pas trouvé nulle part ?
Ligne = Replace(Ligne, "Applicable à", " ")
pour l'instant j'en suis là, avant de continuer, dis moi si je suis sur la bonne voix, j'ai bien retrouvé le nom_fichier "VS/ITR-020"
Daniel
Gobillot
Messages postés
3140
Date d'inscription
vendredi 14 mai 2004
Statut
Membre
Dernière intervention
11 mars 2019
34
26 avril 2005 à 18:07
26 avril 2005 à 18:07
Do While Myfile <> ""
i = i + 1
- - - - - - - - - -
'à placer ici ça évite de le mettre 2 fois
Myname = Mypath & Myfile
Open Myname For Input As #source
- - - - - - - - - -
'pas sûr que ce soit ce que tu veux ????
If InStr(Ligne, "0")= 1 Then
Ligne = Replace(Ligne, "0", vbCrLf)
End If
- - - - - - - - - -
'on les écrit on pas ces lignes modifiées ???
Print #dest, Ligne
Wend
Close #source
'Kill Myname (surtout à éviter avant copie complète)
Close #dest
Myfile = Dir
Loop
Daniel
i = i + 1
- - - - - - - - - -
'à placer ici ça évite de le mettre 2 fois
Myname = Mypath & Myfile
Open Myname For Input As #source
- - - - - - - - - -
'pas sûr que ce soit ce que tu veux ????
If InStr(Ligne, "0")= 1 Then
Ligne = Replace(Ligne, "0", vbCrLf)
End If
- - - - - - - - - -
'on les écrit on pas ces lignes modifiées ???
Print #dest, Ligne
Wend
Close #source
'Kill Myname (surtout à éviter avant copie complète)
Close #dest
Myfile = Dir
Loop
Daniel
cs_audrey08
Messages postés
25
Date d'inscription
lundi 4 avril 2005
Statut
Membre
Dernière intervention
25 mai 2005
27 avril 2005 à 08:38
27 avril 2005 à 08:38
salut . C bien le début de mon programme. Est ce possible de continuer?
Maintenant mon prog fonctionne presque mais j'ai un problème. Si mon fichier de départ tient sur 2 pages, il ne fonctionne plus. Saurais tu me dire pourquoi? Merci
Maintenant mon prog fonctionne presque mais j'ai un problème. Si mon fichier de départ tient sur 2 pages, il ne fonctionne plus. Saurais tu me dire pourquoi? Merci
