Saut de Page en VBA word 2000 !!!

Résolu/Fermé

glaine Messages postés 29 Date d'inscription mercredi 5 novembre 2008 Statut Membre Dernière intervention 23 février 2022 - 4 nov. 2009 à 10:02
glaine Messages postés 29 Date d'inscription mercredi 5 novembre 2008 Statut Membre Dernière intervention 23 février 2022 - 5 nov. 2009 à 18:45

Bonjour à tous !!!
J'ai créé une macro qui insert un saut de page après chaque expression type dans un document. Mon petit souci est que l'expression qui me sert de point de repère disparaît après utilisation de la macro, ce que je ne souhaite pas et je ne vois pas comment l'éviter. Merci d'avance pour toutes les aides apportées.
Amicalement
Sub InsertionSautPage()
Dim expression As String
expression = "Intervenant : "
Selection.Start = ActiveDocument.Content.Start
Selection.End = ActiveDocument.Content.Start
'Proprietes de la recherche a effectuer
With Selection.Find
.text = expression
.Wrap = wdFindStop 'On arrête la recherche à la fin du document
.MatchWildcards = True 'Pour accepter les recherches avec expressions régulières
End With
While Selection.Find.Execute
Selection.InsertBreak Type:=wdPageBreak
Wend

'Replacement du curseur en debut de document
Selection.Start = ActiveDocument.Content.Start
Selection.End = ActiveDocument.Content.Start
End Sub

A voir également:

Saut de Page en VBA word 2000 !!!
Supprimer une page word - Guide
Word numéro de page 1/2 - Guide
Espace insécable word - Guide
Organigramme word - Guide
Bordure de page word - Guide

2 réponses

Réponse 1 / 2

glaine Messages postés 29 Date d'inscription mercredi 5 novembre 2008 Statut Membre Dernière intervention 23 février 2022 1
5 nov. 2009 à 18:45

La solution, pour ceux que cela intéresse:
Sub rechercherRemplacer()
Dim booTrouve As Boolean
Dim inti As Integer
Dim T As Variant
Selection.HomeKey unit:=wdStory
Do
With Selection.Find 'Recherche
.Text = "03/11/2009" 'Mot recherché
.Forward = True
.Wrap = wdFindStop
End With
booTrouve = Selection.Find.Execute 'Exécution de la recherche
If booTrouve Then
Selection.Collapse Direction:=wdCollapseEnd 'suppression de la sélection vers la fin du mot
Selection.InsertBreak Type:=wdPageBreak ' Insertion du saut de page
inti = inti + 1 'contrôle du nombre d'occurences
End If
Debug.Print inti 'Affichage de l'occurence
Loop While booTrouve
T = ActiveDocument.Content.ComputeStatistics(wdStatisticPages)
Selection.GoTo What:=wdGoToPage, Which:=GoToAbsolute, Count:=T
Selection.Delete
With ActiveDocument.Paragraphs
If Left(.Item(.Count).Range, 1) = Chr$(12) Then
.Item(.Count).Range.Delete
End If
End With
Selection.HomeKey unit:=wdStory
End Sub

Réponse 2 / 2

glaine Messages postés 29 Date d'inscription mercredi 5 novembre 2008 Statut Membre Dernière intervention 23 février 2022 1
4 nov. 2009 à 14:22

Bonjour à tous,
Suite à certaines suggestions, j'ai changé un peu mon code, mais il me reste un petit soucis : comment supprimer le dernier saut de page correspondant à la dernière occurence trouvée, afin d'éviter une page vierge et inutile en fin de document ??? (DeleteBreak n'existant pas) Merci encore pour toutes les aides apportées.
Sub rechercherRemplacer()
Dim booTrouve As Boolean
Dim inti As Integer
Dim T As Variant
Selection.Start = ActiveDocument.Content.Start
Selection.End = ActiveDocument.Content.Start
Do
With Selection.Find 'Recherche
.Text = "03/11/2009" 'Mot recherché
.Forward = True
.Wrap = wdFindStop
End With
booTrouve = Selection.Find.Execute 'Exécution de la recherche
If booTrouve Then
Selection.Collapse Direction:=wdCollapseEnd 'suppression de la sélection vers la fin du mot
Selection.InsertBreak Type:=wdPageBreak ' Insertion du saut de page
inti = inti + 1 'contrôle du nombre d'occurences
End If
Debug.Print inti 'Affichage de l'occurence
Loop While booTrouve
T = ActiveDocument.Content.ComputeStatistics(wdStatisticPages)
Selection.GoTo What:=wdGoToPage, Which:=GoToAbsolute, Count:=T
Selection.Delete
If inti = T Then

Selection.Start = ActiveDocument.Content.Start
Selection.End = ActiveDocument.Content.Start
End Sub

Discussions similaires

[PIX] Commencer chaque poème sur une nouvelle page

Discussions similaires

Newsletters