Работа со списками - макрос

[darklumen]

если в тексте встречается список с разными маркерами, то как-то можно их оформить одним общим маркером, например 1) 2) 3) и тд?

например:
1) траляля;
2. траляля;
c. траляля.

а надо

1) ...
2) ...
3) ...

[Busine2009]

Это до выходных. Я и без макросов не всегда могу совладать со списками, а в Word 2007 там вообще не знаешь, что делать.

[Busine2009]

Код: Выделить всё

Sub Lists()
Dim oList As List
With ListGalleries(wdNumberGallery).ListTemplates(2).ListLevels(1)
    .NumberFormat = "%1)"
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = wdListNumberStyleArabic
    .NumberPosition = CentimetersToPoints(0.63)
    .Alignment = wdListLevelAlignLeft
    .TextPosition = CentimetersToPoints(1.27)
    .TabPosition = CentimetersToPoints(1.27)
    .StartAt = 1
End With
For Each oList In ActiveDocument.Lists
    oList.ApplyListTemplate ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(2), _
     ContinuePreviousList:=False, DefaultListBehavior:=wdWord10ListBehavior
Next
End Sub

[darklumen]

спасибо огромное. а не подскажите, как сделать так, чтобы в списках все слова начинались в маленьких букв? +)

[Busine2009]

1 вариант - не учитывает, что первым словом может быть аббревиатура:

Код: Выделить всё

Sub ListsSmallLower()
Dim oListParagraph As Paragraph
Application.ScreenUpdating = False
For Each oListParagraph In ActiveDocument.ListParagraphs
    oListParagraph.SelectNumber
    Selection.MoveRight
    Do While Selection.Text = Chr(32)
        Selection.Delete
    Loop
    Selection.Range.Case = wdLowerCase
Next
Application.ScreenUpdating = True
End Sub

2 вариант - учитывается, что первым словом может быть аббревиатура:

Код: Выделить всё

Sub ListsSmallExtend()
Dim oListParagraph As Paragraph
Application.ScreenUpdating = False
For Each oListParagraph In ActiveDocument.ListParagraphs
    oListParagraph.SelectNumber
    Selection.MoveRight
    Do While Selection.Text = Chr(32)
        Selection.Delete
    Loop
    Selection.MoveRight unit:=wdWord, Extend:=wdExtend
    If Selection.Characters(2).Case <> wdUpperCase Then
        Selection.Range.Case = wdLowerCase
    End If
Next
Application.ScreenUpdating = True
End Sub