numerotation automatique des titres ds word

[Colimaçon]

Je débute sur VBA, c'est mon nouveau job à mon travail, je suis en auto-formation, et je rame pas mal. Je voudrais créer une macro qui numérote automatiquement, chapitre, sous-chapitre, sous-sous-chapitre. Merci à tous ceux qui me dépanneront.

[AlainTech]

Envoyé par Colimaçon

Je voudrais créer une macro

Et qu'est-ce qui t'en empêche?

[ouskel'n'or]

Envoyé par AlainTech

Et qu'est-ce qui t'en empêche?

Allons ! Bienvenue sur le forum, Colimaçon.
Ce qu'on voudrait savoir, enfin je pense qu'AlainTech est comme moi, c'est si tu as commencé quelque chose, si tu as une proposition à nous faire à laquelle on puisse jeter un oeil... parce que là, comme ça, on ne connaît pas la ou les difficultés qui sont les tiennes

[Colimaçon]

J'ai un document sur lequel je dois numeroter les chapitres, sous-chapitres,
ex. : I. - CHAPITRE
1. - SOUS CHAPITRE
a) Sous sous chapitre

J'ai commencé à définir la position des titres, je bloque pour faire fonctionner la hiérarchie des titres, qui s'incrémenteront à chaque fois de +1 automatiquement.
J'espère que mon explication est claire et encore merci...

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Dim monDoc As Document
Dim rgDoc As Range, rgmaPosTitre1Work As Range, rgmaPosTitre2Work As Range
Dim rgmaPosTitre3Work As Range, rgmaPosTitre1 As Range
Dim rgmaPosTitre2 As Range, rgmaPosTitre3 As Range
Dim rst
Dim monTitre1 As Range, monTitre2 As Range, monTitre3 As Range
Dim MonChap As Range
Dim rgDocStart As Long, rgDocEnd As Long
Dim maPosTitre1 As Long, maPosTitre2 As Long, maPosTitre3 As Long
Dim A
Dim B
Dim C
Dim i
Dim n As Integer
 
 
 Set monDoc = ActiveDocument
 Set rgDoc = monDoc.Range
 
    Do
        maPosTitre1 = 0
        maPosTitre2 = 0
        maPosTitre3 = 0
 
        rgDocStart = rgDoc.Start
        rgDocEnd = rgDoc.End
        Set rgDoc = ActiveDocument.Range(rgDocStart, rgDocEnd)
        rgDoc.Select
        With rgDoc.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = ""
            .Style = ActiveDocument.Styles("Titre 1")
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
          End With
              rst = rgDoc.Find.Execute
              If rst = True Then
                rgDoc.Select
                Set rgmaPosTitre1Work = rgDoc
                Set rgmaPosTitre1 = ActiveDocument.Range(0, rgmaPosTitre1Work.End)
                maPosTitre1 = rgmaPosTitre1.Paragraphs.Count
              End If
 
 
        Set rgDoc = ActiveDocument.Range(rgDocStart, rgDocEnd)
        rgDoc.Select
 
                    With rgDoc.Find
                        .ClearFormatting
                        .Replacement.ClearFormatting
                        .Text = ""
                        .Style = ActiveDocument.Styles("Titre 2")
                        .Replacement.Text = ""
                        .Forward = True
                        .Wrap = wdFindStop
                        .Format = True
                        .MatchCase = True
                        .MatchWholeWord = False
                        .MatchWildcards = False
                        .MatchSoundsLike = False
                        .MatchAllWordForms = False
                      End With
                          rst = rgDoc.Find.Execute
                          If rst = True Then
                            rgDoc.Select
                            Set rgmaPosTitre2Work = rgDoc
                            Set rgmaPosTitre2 = ActiveDocument.Range(rgmaPosTitre2Work.Start _
                          , rgmaPosTitre2Work.End)
                            maPosTitre2 = rgmaPosTitre2.Paragraphs.Count
                          End If
                    Set rgDoc = ActiveDocument.Range(rgDocStart, rgDocEnd)
                    rgDoc.Select
                                With rgDoc.Find
                                  .ClearFormatting
                                  .Replacement.ClearFormatting
                                  .Text = ""
                                  .Style = ActiveDocument.Styles("Titre 3")
                                  .Replacement.Text = ""
                                  .Forward = True
                                  .Wrap = wdFindStop
                                  .Format = True
                                  .MatchCase = True
                                  .MatchWholeWord = False
                                  .MatchWildcards = False
                                  .MatchSoundsLike = False
                                  .MatchAllWordForms = False
                                End With
                                    rst = rgDoc.Find.Execute
                                    If rst = True Then
                                      rgDoc.Select
                                      Set rgmaPosTitre3Work = rgDoc
                                      Set rgmaPosTitre3 = ActiveDocument.Range _
                                 (rgmaPosTitre3Work.Start, rgmaPosTitre3Work.End)
                                      maPosTitre3 = rgmaPosTitre3.Paragraphs.Count
                                    End If
 
          MsgBox maPosTitre1 & vbCrLf & maPosTitre2 & vbCrLf & maPosTitre3
 
                            If A < B And A < C Then
                            monTitre1 = monTitre1 + 1
                            monTitre2 = monTitre2 + 0
                            monTitre3 = monTitre3 + 0
                            End If
 
                            If B < A And B < C Then
                            monTitre2 = monTitre2 + 1
                            monTitre3 = monTitre3 + 0
                            End If
 
                            If C < A And C < B Then
                            monTitre3 = monTitre3 + 1
                            End If

Hello limaçon, t'as pas lu les règles et pourtant elles sont bien et t'aideraient dans tes recherches et la rédaction de tes messages. Par exemple, pour que le code ressemble à du code, tu le sélectionnes et tu fais un clic un seul sur le bouton
Bon, pour cette fois...
Balises code ajoutées par ouskel'n'or

[ouskel'n'or]

Déjà, par les lignes qui suivent, que cherches-tu à faire ?

Code :