VBA Word :Pointer sur un titre puis Récupèrer un paragraphe!!! [Résolu]
NS_INSAT8
Messages postés samedi 12 novembre 2005Date d'inscription
23 avril 2010
Dernière intervention
-
19 avril 2010 à 17:43 - Dernière réponse : NS_INSAT8
Messages postés samedi 12 novembre 2005Date d'inscription
23 avril 2010
Dernière intervention
- 23 avril 2010 à 11:59
NS_INSAT8
Messages postés samedi 12 novembre 2005Date d'inscription
23 avril 2010
Dernière intervention -23 avril 2010 à 11:59
3
Merci
Salut bigfish_le vrai,
Merci pour ton aide,
Voila j'ai bidouillé un peu ton code pour pouvoir sélectionner plusieurs paragraphes entre deux titres successives.
ça marche super bien
Voila le code
Public Sub SelPara(Titre As String)
Selection.HomeKey Unit:=wdStory
Dim txte As String
Dim still As String
Dim klk As String
Dim klk2 As String
Dim titretrouve As Boolean
titretrouve = True
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = False
.MatchCase = False
.Wrap = wdFindContinue
.Text = Titre
Do
.Execute
If .Found = True Then 'si on a trouvé quelque chose
'Pour eviter de selectionner le titre du sommaire
If Selection.InRange(ActiveDocument.TablesOfContents(1).Range) = False Then
still = Selection.Paragraphs.Last.Style
klk = Left(still, 5)
If klk = "Titre" Then
Selection.GoToNext what:=wdGoToLine 'pour ne pas selectionner le titre
Debug.Print Selection.MoveDown(Unit:=wdParagraph, Count:=2, Extend:=wdExtend)
Exit Do 'on à trouvé ce que l'on cherchait donc on sort
End If
End If
Else
titretrouve = False '
MsgBox "vérifier le titre "
Exit Do 'on à pas trouvé ce que l'on cherchait alors on sort
End If
DoEvents
Loop
If titretrouve Then 'pour eviter une boucle infinie
Do
still2 = Selection.Paragraphs.Last.Style
klk2 = Left(still2, 5)
If klk2 = "Titre" Then
Debug.Print "titre suivant trouvé"
Debug.Print Selection.MoveUp(Unit:=wdParagraph, Count:=1, Extend:=wdExtend) 'pour ne pas sélectionner le titre suivan
Exit Do
Else
Debug.Print Selection.MoveDown(Unit:=wdParagraph, Count:=1, Extend:=wdExtend)
End If
DoEvents
Loop While klk2 <> "Titre"
End If
End With
Debug.Print Selection.Text
txte = RetourChariot(Selection.Text)
Me.Textpara.Text = txte
End Sub
Tu peux essayer quelque chose comme cela
enregistré avec l'enregistreur de macro à quelques lignes près
Il suffit d'appeler la fonction ci-après et ensuite récupérer dans l'objet Selection le pragraphe qui suit le titre.
Sub ChercherTitreEtLireParagraphe(MonTitre as string)
' revenir en haut du document (sauf si TM existe) il faudrait alors se positionner après la table des matières Goto Tables des matiere suivi d'un selection.MoveRight ...
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = MonTitre
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
' Selection du titre
Selection.MoveRight Unit:=wdParagraph, Count:=1, Extend:=wdExtend
' Selection du paragraphe qui suit le titre
Selection.MoveRight Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.Copy
End Function
Sub test()
Dim Titre As String
Titre = "mon titre"
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = False
.MatchCase = False
.Wrap = wdFindContinue
.Text = Titre
Do
.Execute
If .Found = True Then 'si on a trouvé quelque chose
'Pour eviter de selectionner le titre du sommaire
If Selection.InRange(ActiveDocument.TablesOfContents(1).Range) = False Then
With .Parentraph
'on etend la selection au paragraphe
.Expand Unit:=wdParagraph
.Copy
Exit Do 'on à trouvé ce que l'on cherchait donc on sort
End With
End If
Else
Exit Do 'on à pas trouvé ce que l'on cherchait alors on sort
End If
DoEvents
Loop
End With
End Sub
NS_INSAT8
Messages postés samedi 12 novembre 2005Date d'inscription
23 avril 2010
Dernière intervention -21 avril 2010 à 16:08
0
Merci
Bonjour bigfish_le vrai,
Merci pour t'a réponse,
Ton code m'a l'air très intéressent mais ca me renvois cette erreur au niveau en rouge :
Erreur de compilation
Membres de méthode ou de données introuvables
Public Sub test()
Dim Titre As String
Titre = "Actualisation du document et de ses annexes"
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = False
.MatchCase = False
.Wrap = wdFindContinue
.Text = Titre
Do
.Execute
If .Found = True Then 'si on a trouvé quelque chose
'Pour eviter de selectionner le titre du sommaire
If Selection.InRange(ActiveDocument.TablesOfContents(1).Range) = False Then
With .Parentraph
'on etend la selection au paragraphe
.Expand Unit:=wdParagraph
.Copy
Exit Do 'on à trouvé ce que l'on cherchait donc on sort
End With
End If
Else
Exit Do 'on à pas trouvé ce que l'on cherchait alors on sort
End If
DoEvents
Sub test()
Dim Titre As String
Titre = "mon titre"
With Selection.Find
.Forward = True
.ClearFormatting
.MatchWholeWord = False
.MatchCase = False
.Wrap = wdFindContinue
.Text = Titre
Do
.Execute
If .Found = True Then 'si on a trouvé quelque chose
'Pour eviter de selectionner le titre du sommaire
If Selection.InRange(ActiveDocument.TablesOfContents(1).Range) = False Then
With .Parent
'on etend la selection au paragraphe
.Expand Unit:=wdParagraph
.Copy
Exit Do 'on à trouvé ce que l'on cherchait donc on sort
End With
End If
Else
Exit Do 'on à pas trouvé ce que l'on cherchait alors on sort
End If
DoEvents
Loop
End With
End Sub
a aidé 104 internautes ce mois-ci