Suppression saut de section continu [Résolu]

[DrikS]

Bonjour,

Je dois mettre en forme des documents RTF à partir de macro VBA.

Dans ce document, j'ai des sauts de page, des sauts de section continu et page suivante.

J'aimerai supprimer les sauts de section continus pour conserver l'orientation portrait ou paysage de mon document (grâce aux sauts de section page suivante).

Ce qui m'embête, c'est qu'à part rechercher et remplacer ^b par rien, je n'ai pas d'idée.

Savez vous détecter les sauts de section continus ?

Merci d'avance

Cordialement.

[carden752]

Bonjour,

Qu'est-ce qu'un saut de section continu?
Un saut de section dont le texte s'écrit à la suite du reste.

Une possibilité serait de prendre la page du saut de section et la comparer avec celle du carctère suivant.
Si c'est la même, alors on a un saut de section continu, sinon c'est un autre saut de section.
Problème : Comment identifier le saut de section continu comme dernier caractère d'une page?

Deuxième possibilité, regarder dans la section suivante le type du début de la section.

Je mets les deux solutions même si la deuxième est nettement mieux à mon avis

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 la comparaison des pages
 
Sub testfind()
 
Dim pageprec As Long, pagesuiv As Long
Selection.HomeKey unit:=wdStory
With ActiveDocument.Content.Find
   .ClearFormatting
Do While .Execute(findText:="^b", Forward:=True) = True
.Parent.Select
 
'Comparaison page précédente et page suivante
pageprec = Selection.Information(wdActiveEndPageNumber)
    Selection.GoTo what:=wdGoToSection, which:=wdGoToNext
    pagesuiv = Selection.Information(wdActiveEndPageNumber)
If pagesuiv - pageprec = 0 Then
MsgBox "saut de section continu"
Else: MsgBox "autre saut de section"
End If
Loop
End With
End Sub
 
Ou le type de début de la section 
 
Sub testfind()
 
Dim pageprec As Long, pagesuiv As Long
Selection.HomeKey unit:=wdStory
With ActiveDocument.Content.Find
   .ClearFormatting
Do While .Execute(findText:="^b", Forward:=True) = True
.Parent.Select
    Selection.GoTo what:=wdGoToSection, which:=wdGoToNext
 
'Type du début de la section
If Selection.Sections(1).PageSetup.SectionStart = wdSectionContinuous Then
MsgBox "saut de section continu"
Else: MsgBox "autre saut de section"
End If
Loop
End With
End Sub

[Sepia]

Salut Driks,

Non, oublie tout ça. Dans le modèle des objets Word, tu dispose des sections et des informations sur elles, utilise-les avec un simple code VBA comme celui-ci

Code :

1
2
3
4
5
6
 
    For aI = 1 To ActiveDocument.Sections.Count
        If ActiveDocument.Sections(aI).PageSetup.SectionStart = wdSectionContinuous Then
            MsgBox "Il y a une section avec un saut continu"
        End If
    Next

@+

[carden752]

Bonjour Sepia,

Exact, j'ai tellement cherché à reprendre la partie qu'il avait utilisé soit la recherche du saut de section que j'en ai oublié de travailler avec les sections tout simplement.

[DrikS]

Bonjour et merci pour vos réponses,

Ayant regardé la structure des fichiers RTF en entrée, le problème est un peu différent.

Ce que je veux faire se présente comme suit.

Pour chaque section, si la section courante a une orientation identique à la section d'après, je supprime le saut de section.
Sinon, je laisse le saut de section.

Désolé mais je galère un peu en VBA, j'ai du mal à trouver de l'aide en ligne sur ce genre de problème.

Merci d'avance de votre aide.

[carden752]

Bonjour,

Qu'est-ce que tu veux dire par orientation identique (Portrait et Paysage)?
Si tel est le cas, regardes la propriété orientation et une comparaison de ce style

Code :

1
2
3
IF ActiveDocument.Sections(aI).PageSetup.orientation=ActiveDocument.Sections(aI+1).PageSetup.orientation then 
msgbox "même orientation"
else msgbox "orientation différente"

Attention du coup le parcours doit s'effectuer jusqu'au nombre de sections moins une.

[DrikS]

Envoyé par carden752

Bonjour,

Qu'est-ce que tu veux dire par orientation identique (Portrait et Paysage)?
Si tel est le cas, regardes la propriété orientation et une comparaison de ce style

Oui l'orientation effectivement. Il y a d'autres orientations ?

Envoyé par carden752

Code :

Attention du coup le parcours doit s'effectuer jusqu'au nombre de sections moins une.

C'est un peu sale, mais voilà mon code, qui marche :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Dim i As Integer
Dim j As Integer
Dim tot As Integer
i = 1
j = 2
 
 
For Each Section In ActiveDocument.Sections
        tot = ActiveDocument.Sections.Count
        If i = tot Then
            GoTo fin
        End If
        If ActiveDocument.Sections(i).PageSetup.Orientation = ActiveDocument.Sections(j).PageSetup.Orientation Then
           If ActiveDocument.Sections(i).PageSetup.SectionStart = wdSectionContinuous Or ActiveDocument.Sections(i).PageSetup.SectionStart = wdSectionNewPage Then
           Selection.Find.ClearFormatting
           Selection.Find.Replacement.ClearFormatting
                With Selection.Find
                    .Text = "^b"
                    .Replacement.Text = "^p"
                    .Forward = True
                    .Wrap = wdFindStop
                    .Format = False
                    .MatchCase = False
                    .MatchWholeWord = False
                    .MatchWildcards = False
                    .MatchSoundsLike = False
                    .MatchAllWordForms = False
                End With
                With Selection
                    If .Find.Forward = True Then
                        .Collapse Direction:=wdCollapseStart
                    Else
                        .Collapse Direction:=wdCollapseEnd
                    End If
                    .Find.Execute Replace:=wdReplaceOne
                    If .Find.Forward = True Then
                        .Collapse Direction:=wdCollapseEnd
                    Else
                        .Collapse Direction:=wdCollapseStart
                    End If
                    .Find.Execute
                End With
           End If
        Else
            Selection.MoveDown Unit:=wdLine, Count:=2
            i = i + 1
            j = j + 1
        End If
 
    Next Section
fin:

Merci à tous, je passe le topic en