Как создать нумерованный список?

@Randen · Регистрация: 06.01.2014

Студворк — интернет-сервис помощи студентам

Добрый вечер.
Обыскал все что можно. Почитал инфу о работе с вордом, но не нашел как создать список. Прошу помощи)
Пример:

1) пункт 1
2) пункт 2
3) пункт 3

@Апострофф · 29.08.2014, 11:31

Выделяем будущий список, включаем макрорекордер и получаем

-

Visual Basic
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
Sub Макрос1()
  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)
    .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 = wdUndefined
      .Animation = wdUndefined
      .DoubleStrikeThrough = wdUndefined
      .Name = ""
    End With
    .LinkedStyle = ""
  End With
  ListGalleries(wdNumberGallery).ListTemplates(2).Name = ""
  Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
    wdNumberGallery).ListTemplates(2), ContinuePreviousList:=False, ApplyTo:= _
    wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
End Sub

Что тут лишнее - гадайте сами

@Randen · 29.08.2014, 11:49 **[ТС]**

Апострофф, Спасибо.
Дело в том, что я прогаю не на VB и мне сложно разобраться в коде.
Я пишу на PureBasic, и там используются вставки VB в функции работы с COM.

Visual Basic
1
2
3
Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
    wdNumberGallery).ListTemplates(2), ContinuePreviousList:=False, ApplyTo:= _
    wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior

Что за ListTemplates? Почему тут в 1 строке пробел стоит?
Мне бы справку хорошую по всему этому. Видел вчера на специализированном сайте microsoft справку по COM на русском, но потерял сайт и найти теперь не могу.
Пожалуйста, приведите код по проще.

Добавлено через 2 минуты

Visual Basic
1
With ListGalleries(wdNumberGallery).ListTemplates(2).ListLevels(1)

Это так создается обычный структурированный список?

Аксима · 29.08.2014, 15:28

Сообщение от Randen

Пожалуйста, приведите код по проще.

Написал код для создания нумерованного списка вручную. Может быть, так будет вам проще для понимания.

Visual Basic
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
Sub AddNumberedList()
    'Основные переменные документа Word, описывающие соответственно
    'приложение, документ и диапазон в документе.
    Dim app As Word.Application, doc As Word.Document, rng As Word.Range
    'Переменные, необходимые для работы со списками.
    Dim lsg As Word.ListGallery   'Галерея шаблонов списков.
    Dim lst As Word.ListTemplate  'Шаблон списка.
    'Получаем доступ к приложению Word.
    Set app = GetObject(, "Word.Application")
    'Получаем доступ к активному документу в этом приложении.
    Set doc = app.ActiveDocument
    'Получаем галерею шаблонов нумерованных списков.
    Set lsg = app.ListGalleries(2)  'Всего есть 3 галереи:
                                    '1-я - маркированные списки.
                                    '2-я - нумерованные списки.
                                    '3-я - многоуровневые списки.
    'Из множества шаблонов нумерованных списков выбираем тот,
    'который с арабскими цифрами и скобкой ")".
    For Each lst In lsg.ListTemplates
        With lst.ListLevels(1)
            If Right(.NumberFormat, 1) = ")" And .NumberStyle = 0 Then Exit For
        End With
    Next lst
    'Получаем ссылку на диапазон всего документа.
    Set rng = doc.Range
    rng.Delete
    'Вставляем в документ текст, к которому будет применяться список.
    rng.Text = "пункт 1" & vbCrLf & "пункт 2" & vbCrLf & "пункт 3"
    'Определяем формат списка с помощью шаблона lst.
    rng.ListFormat.ApplyListTemplate lst
End Sub

С уважением,

Аксима

P.S. Изменил название вашей темы с "Как создать маркированный список в Word" на "Как создать нумерованный список в Word", так как в примере у вас нумерованный список. Если был не прав и вам нужен именно маркированный список, то вместо второй галереи выберите первую и участок кода, где идет перебор шаблонов, замените простым выбором нужного шаблона.

@Randen · 29.08.2014, 20:06 **[ТС]**

Аксима, спасибо. Намного проще

@Аватар-С · 16.01.2018, 16:41

Здравствуйте Коллеги!

Это если нужно вставить просто нумерованный список.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
    Set rng = Doc.Range
    'rng.Delete
    txt = ChrW(0)
 
    For i = 1 To 9
        i = i
        txt = txt & vbCrLf
    Next 'i
    rng.Text = txt '& ChrW(0)
    
    rng.ListFormat.ApplyListTemplate lst

С уважением, Аватар-С

Добавлено через 1 час 5 минут
Извините не тот код воткнул.

Visual Basic
1
2
3
4
5
6
7
8
9
    Set rng = Doc.Range
    rng.Delete
    For i = 1 To 9
        i = i
        txt = txt & ChrW(0) & vbCrLf
    Next i
    rng.Text = txt & ChrW(0)
 
    rng.ListFormat.ApplyListTemplate lst

Добавлено через 3 часа 11 минут
От не чего делать!

Visual Basic
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
'Option Explicit
 
Sub ВставитьПриложение()
'ПРИЛОЖЕНИЕ
On Error GoTo Err_DOC: If ActiveDocument.Name <> "" Then GoTo NoErr_DOC
Err_DOC: MvbErr (msg): Exit Sub
NoErr_DOC:
    'СООБЩЕНИЯ
    msg = "Продолжить, вставку ""Приложение""?"
    
    Set oRange = ActiveDocument.Range(Start:=Word.Selection.Start, End:=Word.Selection.Start)
    Dim oTable As Table, удалить As Table
    ширина = Fix(25 / 0.3528) 'для ширины столбца в мм
        
    'ПОДТВЕРЖДЕНИЕ
    If MvbYesNo(msg) = vbNo Then Exit Sub
    
    'УДАЛЯЕМ СТАРУЮ ТАБЛИЦУ
    If ActiveDocument.Tables.Count > 0 Then
        For Each удалить In Selection.Tables
        удалить.Delete
        Next удалить
    End If
 
    'ВСТАВЛЯЕМ НОВУЮ ТАБЛИЦУ
    Dim до As Byte: до = 6
    oRange.ParagraphFormat.Reset 'очищаем форматирование
    Set oTable = ActiveDocument.Tables.Add(oRange, 2, 2)
        oTable.Select
        oTable.Columns(1).Width = ширина 'первой колонки
        oTable.PreferredWidthType = 2    'ширина таблицы
        oTable.PreferredWidth = 100      'ширина таблицы
        Selection.Tables(1).Cell(1, 1).Range = "Приложение:"
        Selection.Tables(1).Cell(1, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        Selection.Tables(1).Cell(2, 1).Range = "Всего"
        Selection.Tables(1).Cell(2, 1).Range.ParagraphFormat.SpaceBefore = до
        Selection.Tables(1).Cell(2, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        Selection.Tables(1).Cell(2, 2).Range = "? л."
        Selection.Tables(1).Cell(2, 2).Range.ParagraphFormat.SpaceBefore = до
        Selection.Tables(1).Cell(2, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
        Selection.Tables(1).Cell(1, 1).VerticalAlignment = wdCellAlignVerticalTop
        Selection.Tables(1).Cell(1, 2).VerticalAlignment = wdCellAlignVerticalTop
        Selection.ParagraphFormat.LineSpacing = LinesToPoints(1) 'междустрочный интервал
        Selection.ParagraphFormat.SpaceBefore = LinesToPoints(0) 'интервал перед параграфа  0.999 = 12
        Selection.ParagraphFormat.SpaceAfter = LinesToPoints(0)  'интервал после параграфа
 
    'ФОРМАТИРУЕМ ТАЛЛИЦЫ
    With oRange
        .Rows.WrapAroundText = False
        .Rows.Alignment = VerticalAlignment   'выравнивание на листе по левому краю поля
        .Rows.HeightRule = wdRowHeightAuto    'убирает галочку "Высота строки"
    End With
 
    'СОЗДАНИЕ И ОБРАБОТКА СПИСКА
    Dim lsg As Word.ListGallery, lst As Word.ListTemplate
        Set app = GetObject(, "Word.Application")
        Set Doc = Selection.Tables(1).Cell(1, 2)    'выделенная таблица
        Set lsg = app.ListGalleries(2)              'нумерованные списки.
        Set rng = Doc.Range
        
    For Each lst In lsg.ListTemplates
        With lst.ListLevels(1)
            If Right(.NumberFormat, 1) = "." And .NumberStyle = 0 Then Exit For '*
        End With
    Next lst
 
    'ОБРАБОТКА INPUTBOX
    Dim Message As String, Title As String, Default As String, MyValue As String
    Message = "Укажите колличество позиций"
    Title = MM
    Default = ""
    MyValue = InputBox(Message, Title, Default)
    rW = ChrW(8234)
    
    If MyValue = "" Then Exit Sub
    If MyValue = 0 Then Exit Sub
    If MyValue = 1 Then rng.Text = rW: GoTo d
    If MyValue = 2 Then MyValue = MyValue - 1
    If MyValue > 2 Then MyValue = MyValue - 1
    
    rng.Delete
    For i = 1 To MyValue 'если 10 - 1
        i = i: txt = txt & rW & vbCrLf
    Next i
    rng.Text = txt & rW
    
d:  'ФОРМАТИРУЕМ СПИСОК
    rng.ListFormat.ApplyListTemplate lst
    With lst.ListLevels(1)
            .Alignment = 2          'выравнивание по правому краю
            .NumberPosition = 20    'отступ слева
            .TextPosition = 20      'задает положение для второй линии
            .TrailingCharacter = 1  'символ после номера 0 - Tab, 1 - пробел
    End With
End Sub
 
Function MvbErr(msg) As String
'MsgBox ОШИБКА АКТИВНОСТИ ДОКУМЕНТА
    msg = "Необходимо открыть или создать документ!"
    Button = vbYes + 64
    Title = MM()
    MvbErr = MsgBox(msg, Button, Title)
End Function
 
Function MvbYesNo(ByVal msg) As String
'MsgBox ДА/НЕТ
    Button = vbYesNo + 64
    Title = MM
    MvbYesNo = MsgBox(msg, Button, Title)
End Function
 
Function MM() 'As String
    MM = "Вставить ""Приложение"""
End Function

С уважением, Аватар-С

Новые блоги и статьи Все статьи Все блоги /
сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .
Модель микоризы: классовый агентный подход 3 anaschu 06.01.2026 aa0a7f55b50dd51c5ec569d2d10c54f6/ O1rJuneU_ls https:/ / vkvideo. ru/ video-115721503_456239114	Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ФедосеевПавел 06.01.2026 Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ВВЕДЕНИЕ Введу сокращения: аналоговый ПИД — ПИД регулятор с управляющим выходом в виде числа в диапазоне от 0% до. . .	Модель микоризы: классовый агентный подход 2 anaschu 06.01.2026 репозиторий https:/ / github. com/ shumilovas/ fungi ветка по-частям. коммит Create переделка под биомассу. txt вход sc, но sm считается внутри мицелия. кстати, обьем тоже должен там считаться. . . .	Расчёт токов в цепи постоянного тока igorrr37 05.01.2026 / * Дана цепь постоянного тока с сопротивлениями и источниками (напряжения, ЭДС и тока). Найти токи и напряжения во всех элементах. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа и. . .

@Randen 35 / 35 / 15 Регистрация: 06.01.2014 Сообщений: 707
	29.08.2014, 20:06 [ТС]
	Аксима, спасибо. Намного проще 0