Modify bullet size in word

[mathos]

Hi,

I have a word document with many bullets of different sizes (12, 22, 24, 26,...) and I want to make a macro that can change the size of every bullet to 12.

How can I do this?

I have tried to apply a template but doesn't seem to works...
Sub Macro3()
'
' Macro3 Macro
'
'
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).listLevels(1)
.NumberFormat = ChrW(61623)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(0.63)
.TabPosition = wdUndefined
.ResetOnHigher = 0
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = 12
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = "Symbol"
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).listLevels(2)
.NumberFormat = "o"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = CentimetersToPoints(0.63)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(1.27)
.TabPosition = wdUndefined
.ResetOnHigher = 1
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = 12
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = "Times New Roman"
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).listLevels(3)
.NumberFormat = "-"
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleNone
.NumberPosition = CentimetersToPoints(1.27)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(1.9)
.TabPosition = wdUndefined
.ResetOnHigher = 2
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = 12
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = ""
End With
.LinkedStyle = ""
End With
With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).listLevels(4)
.NumberFormat = ChrW(61558)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = CentimetersToPoints(1.9)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(2.54)
.TabPosition = wdUndefined
.ResetOnHigher = 3
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = 12
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = "Wingdings"
End With
.LinkedStyle = ""
End With

ListGalleries(wdOutlineNumberGallery).ListTemplates(1).Name = "math"
Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdOutlineNumberGallery).ListTemplates(1), _
ContinuePreviousList:=True, ApplyTo:=wdListApplyToWholeList, _
DefaultListBehavior:=wdWord10ListBehavior

Selection.WholeStory
Selection.Font.Name = "Calibri"
Selection.Font.Size = 11
For Each aaa In ActiveDocument.Lists
aaa.ApplyListTemplate ListTemplate:=ListGalleries(wdOutlineNumberGallery).ListTemplates(1)
Next

End Sub

Thanks