Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Word Détecter la fin du document

Détecter la fin du document

8 réponses
Avatar
galopin01
Bonjour,
j'ai écrit cette macro pour modifier un fichier .txt et pouvoir l'importer
sous Excel :
Mon problème est que cette macro continue de tourner même quand il n'y a
plus rien à remplacer et elle insère des caractères 13 et elle insère des
caractères 13 et....
Bon je sais l'interrompre avec Ctrl Pause mais j'aimerai un truc dans le
code pour sortir de cette boucle...
J'ai essayé On Error GoTo...
et d'autres trucs avec wdFindAsk mais ce n'était pas concluant...
Avec vous la solution ?

Sub Test()
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = ";"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
End With
Do
For i = 1 To 37
Selection.Find.Execute
Next
Selection = Replace(Selection, ";", Chr(13))
Selection.MoveRight Unit:=wdCharacter, Count:=1
Loop
End Sub

Merci
Signaler un problème avec ce contenu

8 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Geo
Bonjour
[ Cette réponse est faite sur le forum public Word :
news://msnews.microsoft.com/microsoft.public.fr.word ]



Vite fait :

Le moveright retourne une valeur, extrait de l'aide:

"Cet exemple montre comment déplacer la sélection d'un caractère vers
la droite. Si le déplacement réussit, MoveRight renvoie la valeur 1.
If Selection.MoveRight = 1 Then MsgBox "Move was successful" "

--
A+
Avatar
michdenis
Bonjour,

Si tu ouvres l'application Excel,
Tu peux ouvrir directement un fichier .txt ou .csv.
Fichier / Ouvrir / dans la liste déroulante du bas de la
fenêtre, tu modifies le type de fichier pour .csv, txt
et tu sélectionnes le fichier texte (.txt) qui te convient.
Il ne te reste plus qu'à suivre l'assistant pour compléter
l'importation.

Si tu veux le faire par macro : Un exemple
L'importation se fait une ligne à la fois et la copie
dans la cellule de la colonne A du classeur
Cela dépend du contenu de ton fichier...
'-------------------------------------------
Sub Import_Fichier_Texte_Dans_Excel()
dim i as Long = 1, Ligne As String
open "c:LeCheminMonDocument.txt" for input as 1
i=1
do while not eof(1)
line input #1, ligne
With Worksheets("Feuil1")
.cells(i,1).value = ligne
i=i + 1
End with
loop
'-------------------------------------------


"galopin01" a écrit dans le message de groupe de
discussion :
Bonjour,
j'ai écrit cette macro pour modifier un fichier .txt et pouvoir l'importer
sous Excel :
Mon problème est que cette macro continue de tourner même quand il n'y a
plus rien à remplacer et elle insère des caractères 13 et elle insère des
caractères 13 et....
Bon je sais l'interrompre avec Ctrl Pause mais j'aimerai un truc dans le
code pour sortir de cette boucle...
J'ai essayé On Error GoTo...
et d'autres trucs avec wdFindAsk mais ce n'était pas concluant...
Avec vous la solution ?

Sub Test()
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = ";"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
End With
Do
For i = 1 To 37
Selection.Find.Execute
Next
Selection = Replace(Selection, ";", Chr(13))
Selection.MoveRight Unit:=wdCharacter, Count:=1
Loop
End Sub

Merci
Avatar
michdenis
Une autre petite procédure pour remplacer tous les ";" par
le caractère Chr(13) pour la totalité du fichier dans le
fichier texte lui-même sans rien exporter vers Excel.

'-----------------------------------
Sub Modifier_Fichiers_Texte_Répertoire_Entier()

Dim Temp As String, Chemin As String
Dim Fichier As String, X As Long
Dim AncEle As String, NouEle As String

'******Variables à définir**************
Chemin = "C:UsersDMDocuments"
Fichier = "MonFichier.txt"

'Élément à changer - Modifier ";"
'par le caractère chr(13
AncEle = ";"
NouEle = Chr(13)
'****************************************
X = FreeFile
if = Dir(Chemin & fichier) <>"" then
Open Chemin & fichier For Binary Access Read As #X
Temp = String(LOF(X), Chr(0))
Get #X, , Temp
Close #X
'remplacement à effectuer
Temp = Replace(Temp, AncEle, NouEle)
Open Chemin & fichier For Output As #X
Print #X, Temp
Close #X
else
Msgbox "Fichier inexistant dans le chemin indiqué."
end if
End Sub
.-------------------------------------



"michdenis" a écrit dans le message de groupe de discussion :

Bonjour,

Si tu ouvres l'application Excel,
Tu peux ouvrir directement un fichier .txt ou .csv.
Fichier / Ouvrir / dans la liste déroulante du bas de la
fenêtre, tu modifies le type de fichier pour .csv, txt
et tu sélectionnes le fichier texte (.txt) qui te convient.
Il ne te reste plus qu'à suivre l'assistant pour compléter
l'importation.

Si tu veux le faire par macro : Un exemple
L'importation se fait une ligne à la fois et la copie
dans la cellule de la colonne A du classeur
Cela dépend du contenu de ton fichier...
'-------------------------------------------
Sub Import_Fichier_Texte_Dans_Excel()
dim i as Long = 1, Ligne As String
open "c:LeCheminMonDocument.txt" for input as 1
i=1
do while not eof(1)
line input #1, ligne
With Worksheets("Feuil1")
.cells(i,1).value = ligne
i=i + 1
End with
loop
'-------------------------------------------


"galopin01" a écrit dans le message de groupe de
discussion :
Bonjour,
j'ai écrit cette macro pour modifier un fichier .txt et pouvoir l'importer
sous Excel :
Mon problème est que cette macro continue de tourner même quand il n'y a
plus rien à remplacer et elle insère des caractères 13 et elle insère des
caractères 13 et....
Bon je sais l'interrompre avec Ctrl Pause mais j'aimerai un truc dans le
code pour sortir de cette boucle...
J'ai essayé On Error GoTo...
et d'autres trucs avec wdFindAsk mais ce n'était pas concluant...
Avec vous la solution ?

Sub Test()
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = ";"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
End With
Do
For i = 1 To 37
Selection.Find.Execute
Next
Selection = Replace(Selection, ";", Chr(13))
Selection.MoveRight Unit:=wdCharacter, Count:=1
Loop
End Sub

Merci
Avatar
galopin01
bonjour,
la première proposition ne me semble pas convenit car c'est ma boucle find
qui devrait détecter qu'elle ne trouve plus rien... or malgré qu'elle ne
trouve plus de ";" elle continue de tourner et le replace continue d'insérer
des Car(13)
Si je me réfère à ce que je sais faire (sous Excel !) il faudrai pouvoir
tester que la sélection contient bien un ";" avant d'effectuer le replace,
mais pour l'instant mes différents essais se sont soldés par des échecs.
Mais je ne désespère pas !

La deuxième proposition ne semble pas convenir car comme le fichier ne
contient pas de retour ligne. l'importation plante dès la première ligne.
C'est l'objet de cette macro de placer un Car(13) à la place du 37 ème ";"
pour pouvoir importer ensuite...
Quand à la 3ème proposition, il faut que je teste, mais comme il n'y à pas
de ligne, que des mots ou des phrases séparées par des ";" j'ai l'impression
que ça ne va pas bien se passer... de plus je dois préserver les 36 premiers
";" pour pouvoir me servir du délimiteur à l'importation...

La macro que j'ai donnée fait bien le travail sauf qu'elle ne s'arrête pas :
je suis obligé de la stopper par Ctrl+Pause

Voici un petit bout du fichier démo :
http://www.eabressane.com/pictures/pdfdiv/1.txt

Merci quand même de votre attention.
A+




"michdenis" a écrit dans le message de news:

Une autre petite procédure pour remplacer tous les ";" par
le caractère Chr(13) pour la totalité du fichier dans le
fichier texte lui-même sans rien exporter vers Excel.

'-----------------------------------
Sub Modifier_Fichiers_Texte_Répertoire_Entier()

Dim Temp As String, Chemin As String
Dim Fichier As String, X As Long
Dim AncEle As String, NouEle As String

'******Variables à définir**************
Chemin = "C:UsersDMDocuments"
Fichier = "MonFichier.txt"

'Élément à changer - Modifier ";"
'par le caractère chr(13
AncEle = ";"
NouEle = Chr(13)
'****************************************
X = FreeFile
if = Dir(Chemin & fichier) <>"" then
Open Chemin & fichier For Binary Access Read As #X
Temp = String(LOF(X), Chr(0))
Get #X, , Temp
Close #X
'remplacement à effectuer
Temp = Replace(Temp, AncEle, NouEle)
Open Chemin & fichier For Output As #X
Print #X, Temp
Close #X
else
Msgbox "Fichier inexistant dans le chemin indiqué."
end if
End Sub
.-------------------------------------



"michdenis" a écrit dans le message de groupe de
discussion :

Bonjour,

Si tu ouvres l'application Excel,
Tu peux ouvrir directement un fichier .txt ou .csv.
Fichier / Ouvrir / dans la liste déroulante du bas de la
fenêtre, tu modifies le type de fichier pour .csv, txt
et tu sélectionnes le fichier texte (.txt) qui te convient.
Il ne te reste plus qu'à suivre l'assistant pour compléter
l'importation.

Si tu veux le faire par macro : Un exemple
L'importation se fait une ligne à la fois et la copie
dans la cellule de la colonne A du classeur
Cela dépend du contenu de ton fichier...
'-------------------------------------------
Sub Import_Fichier_Texte_Dans_Excel()
dim i as Long = 1, Ligne As String
open "c:LeCheminMonDocument.txt" for input as 1
i=1
do while not eof(1)
line input #1, ligne
With Worksheets("Feuil1")
.cells(i,1).value = ligne
i=i + 1
End with
loop
'-------------------------------------------


"galopin01" a écrit dans le message de
groupe de
discussion :
Bonjour,
j'ai écrit cette macro pour modifier un fichier .txt et pouvoir l'importer
sous Excel :
Mon problème est que cette macro continue de tourner même quand il n'y a
plus rien à remplacer et elle insère des caractères 13 et elle insère des
caractères 13 et....
Bon je sais l'interrompre avec Ctrl Pause mais j'aimerai un truc dans le
code pour sortir de cette boucle...
J'ai essayé On Error GoTo...
et d'autres trucs avec wdFindAsk mais ce n'était pas concluant...
Avec vous la solution ?

Sub Test()
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = ";"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
End With
Do
For i = 1 To 37
Selection.Find.Execute
Next
Selection = Replace(Selection, ";", Chr(13))
Selection.MoveRight Unit:=wdCharacter, Count:=1
Loop
End Sub

Merci



Avatar
galopin01
Finalement, j'ai réussi à stopper la machine infernale... En testant la
sélection après Find.Execute

Sub Test()
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = ";"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
End With
Do
For i = 1 To 37
Selection.Find.Execute
Next
If Selection.Text = ";" Then
Selection = Replace(Selection, ";", Chr(13))
Selection.MoveRight Unit:=wdCharacter, Count:=1
Else
End
End If
Loop
End Sub

... mais je suis preneur d'une solution directe sous Excel (avec Open) si tu
peux me dire comment on parse enregistrement par enregistrement pour aller
sur la ligne suivante après le 67ème ";"
Bon, c'est juste pour me coucher moins bête ce soir. Hein ! Faut pas que ça
vous empêche de dormir !
Merci à tous !

A+
Avatar
db
galopin01 a écrit :
Finalement, j'ai réussi à stopper la machine infernale... En testant la
sélection après Find.Execute



.... mais je suis preneur d'une solution directe sous Excel (avec Open) si tu
peux me dire comment on parse enregistrement par enregistrement pour aller
sur la ligne suivante après le 67ème ";"



Bonsoir,

Quelque chose comme ça, dans une procédure excel, pour parser un fichier
texte (qui ne doit pas excéder 32767 caractères) :

Sub test()
Dim texte As String, i As Integer, j As Integer
Dim l As Integer, c As Integer

Open "D:ExcelTest.txt" For Input As #1
Input #1, texte
Close #1
l = 1
j = 1
c = 1
i = InStr(texte, ";")
While i > 0
With Worksheets("Feuil1")
.Cells(l, c).Value = Mid(texte, j, i - j)
End With
j = i + 1
c = c + 1
If c = 38 Then
c = 1
l = l + 1
End If
i = InStr(j, texte, ";")
Wend

End Sub

...mais on peut sûrement faire plus simple :-)

db
Avatar
Geo
Re

Je vous avais donné une piste en exploitant le résultat du moveRight,
elle devrait arrêter la boucle, mais je n'avais pas le temps de tester.

En relisant votre énoncé, il s'agit simplement de remplacer un
caractère par un autre ?
Dans ce cas, l'enregistreur de macros est votre ami.
Il va vous montrer comment on fait un remplacement sur tout un
document.

Décidément, je vois que les solutions simples ne conviennent pas aux
spécialistes d'Excel.

--
A+
Avatar
galopin01
Bonsoir
C'était quasiment parfait !
Je n'ai eu qu'une petite frayeur : la colonne 4 sortait en notation
scientifique ce qui ne faisait pas mon affaire...
J'ai juste eu à supprimer le .Value dans :

With Worksheets("Feuil1")
.Cells(l, c).Value = Mid(texte, j, i - j)
End With



Et ça marche pile poil !
C'est trop top !
Bravo et merci encore.
A+



"db" a écrit dans le message de news:

galopin01 a écrit :
Finalement, j'ai réussi à stopper la machine infernale... En testant la
sélection après Find.Execute



.... mais je suis preneur d'une solution directe sous Excel (avec Open)
si tu peux me dire comment on parse enregistrement par enregistrement
pour aller sur la ligne suivante après le 67ème ";"



Bonsoir,

Quelque chose comme ça, dans une procédure excel, pour parser un fichier
texte (qui ne doit pas excéder 32767 caractères) :

Sub test()
Dim texte As String, i As Integer, j As Integer
Dim l As Integer, c As Integer

Open "D:ExcelTest.txt" For Input As #1
Input #1, texte
Close #1
l = 1
j = 1
c = 1
i = InStr(texte, ";")
While i > 0
With Worksheets("Feuil1")
.Cells(l, c).Value = Mid(texte, j, i - j)
End With
j = i + 1
c = c + 1
If c = 38 Then
c = 1
l = l + 1
End If
i = InStr(j, texte, ";")
Wend

End Sub

...mais on peut sûrement faire plus simple :-)

db