Sub AjouteStyles()
	Dim saveLineSpacing
	saveLineSpacing = ActiveDocument.Styles("Liste à numéros").ParagraphFormat.LineSpacing
	Dim saveLineSpacingRule
	saveLineSpacingRule = ActiveDocument.Styles("Liste à numéros").ParagraphFormat.LineSpacingRule
	Call CreerStyle("ListeN", saveLineSpacingRule, saveLineSpacing, -17)
	Call CreerStyle("ListeNN", saveLineSpacingRule, saveLineSpacing, -24)
	Call CreerStyle("ListeNNN", saveLineSpacingRule, saveLineSpacing, -31)
	Call CreerStyle("ListeNNNN", saveLineSpacingRule, saveLineSpacing, -38)
	AppliqueNouveauxStyles
End Sub
Sub AppliqueNouveauxStyles()
	Application.ScreenUpdating = False
	Selection.HomeKey Unit:=wdStory
	Dim Parag As Paragraph
	Dim LeNumero
	For Each Parag In ActiveDocument.Paragraphs
		If Parag.Style = "Liste à numéros" Then
			LeNumero = Val(Replace(Parag.Range.ListFormat.ListString, ".", ""))
			If LeNumero < 10 Then
				Parag.Range.Select
				Selection.Style = ActiveDocument.Styles("ListeN")
			ElseIf LeNumero > 9 And LeNumero < 100 Then
				Parag.Range.Select
				Selection.Style = ActiveDocument.Styles("ListeNN")
			ElseIf LeNumero > 99 And LeNumero < 1000 Then
				Parag.Range.Select
				Selection.Style = ActiveDocument.Styles("ListeNNN")
			ElseIf LeNumero > 999 And LeNumero < 10000 Then
				Parag.Range.Select
				Selection.Style = ActiveDocument.Styles("ListeNNNN")
			End If
		End If
	Next Parag
	Selection.HomeKey Unit:=wdStory
	Application.ScreenUpdating = True
End Sub
Sub CreerStyle(NomStyle, RegleInterligne, InterLigne, Indentation)
	ActiveDocument.Styles.Add Name:=NomStyle, Type:=wdStyleTypeParagraph
	ActiveDocument.Styles(NomStyle).AutomaticallyUpdate = False
	With ActiveDocument.Styles(NomStyle).Font
		.Name = "Times New Roman"
		.Size = 12
		.UnderlineColor = wdColorAutomatic
		.Color = wdColorAutomatic
		.Scaling = 100
		.Kerning = 0
		.NumberSpacing = wdNumberSpacingDefault
		.NumberForm = wdNumberFormDefault
		.StylisticSet = wdStylisticSetDefault
		.ContextualAlternates = 0
	End With
	With ActiveDocument.Styles(NomStyle).ParagraphFormat
		.LeftIndent = 38
		.RightIndent = 0
		.SpaceBefore = 0
		.SpaceBeforeAuto = False
		.SpaceAfter = 0
		.SpaceAfterAuto = False
		.LineSpacingRule = RegleInterligne
		.LineSpacing = Interligne
		.Alignment = wdAlignParagraphJustify
		.WidowControl = True
		.KeepWithNext = False
		.KeepTogether = False
		.PageBreakBefore = False
		.NoLineNumber = False
		.Hyphenation = True
		.FirstLineIndent = Indentation
		.OutlineLevel = wdOutlineLevelBodyText
		.CharacterUnitLeftIndent = 0
		.CharacterUnitRightIndent = 0
		.CharacterUnitFirstLineIndent = 0
		.LineUnitBefore = 0
		.LineUnitAfter = 0
		.MirrorIndents = False
		.TextboxTightWrap = wdTightNone
		.CollapsedByDefault = False
	End With
	ActiveDocument.Styles(NomStyle).NoSpaceBetweenParagraphsOfSameStyle = True
	ActiveDocument.Styles(NomStyle).ParagraphFormat.TabStops.ClearAll
	ActiveDocument.Styles(NomStyle).LanguageID = wdFrench
	ActiveDocument.Styles(NomStyle).NoProofing = False
	ActiveDocument.Styles(NomStyle).Frame.Delete
End Sub