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 |
Partager