Автоматическая нумерация с MS Word VBA - PullRequest
0 голосов
/ 28 августа 2018

Предположим, у меня есть файл слов, который содержит следующий текст:

  1. Этот текст1
  2. Этот текст2
  3. Этот текст3
  4. Этот текст4
  5. Этот текст5
  6. Этот текст6

Теперь я хочу автоматическую нумерацию, результат будет следующим:

  1. Этот текст1
  2. Этот текст2
  3. Этот текст3
  4. Этот текст4
  5. Этот текст5
  6. Этот текст6

Я использую следующий код, но он не работает.

Sub DoAutoNumber()

Const S_FIND As String = "([0-9]@)[.|]"
Dim myNumber As Integer

    myNumber = 1

    Do While InStr(ActiveDocument.Content, S_FIND) > 0
        With ActiveDocument.Content.Find
            .ClearFormatting
            .Text = S_FIND
            .MatchWildcards = True
            .Font.Color = wdColorViolet
            .Execute Replace:=wdReplaceOne, ReplaceWith:="(" & myNumber & ")", _
                     Forward:=True
        End With
        myNumber = myNumber + 1
    Loop

End Sub

Не могли бы вы предложить мне? спасибо.

Ответы [ 2 ]

0 голосов
/ 28 августа 2018

Это код, который я тестировал. Вы можете попробовать это

Sub Demo()
 With ListGalleries(wdNumberGallery).ListTemplates(1).ListLevels(1)
    .NumberFormat = "%1."
    .TrailingCharacter = wdTrailingTab
    .NumberStyle = wdListNumberStyleArabic
    .NumberPosition = CentimetersToPoints(0)
    .Alignment = wdListLevelAlignLeft
    .TextPosition = CentimetersToPoints(0.74)
    .TabPosition = CentimetersToPoints(0.74)
    .ResetOnHigher = 0
    .StartAt = 1
    .LinkedStyle = ""
End With
ListGalleries(wdNumberGallery).ListTemplates(1).Name = ""
Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
    wdNumberGallery).ListTemplates(1), ContinuePreviousList:=False, ApplyTo:= _
    wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
End Sub

Before

after

Надеюсь, это поможет!

0 голосов
/ 28 августа 2018

Запустите этот макрос (Sub CorrectNumbers), что должно сработать. Каким-то образом мне нужно было сделать 2 цикла, так как прямой цикл не заканчивался, потому что SearchString всегда заменялся одними и теми же метриками, и цикл начинался снова и снова. Вот почему я добавил держатель ($ temp§)

Sub CorrectNumbers()

Dim Rng As Range: Set Rng = ActiveDocument.Range
Dim SearchString$
Dim SearchString2$: SearchString2 = "§temp§"
Dim myNumber%: myNumber = 1

SearchString = "([0-9]@)[.]"
    With Rng.Find
    .MatchWildcards = True
    .Forward = True
        Do While .Execute(FindText:=SearchString, ReplaceWith:=myNumber & "§temp§.") = True
        myNumber = myNumber + 1
        Rng.Collapse wdCollapseStart
        Loop
    End With

    With Rng.Find
    .MatchWildcards = False
    .Forward = True
        Do While .Execute(FindText:=SearchString2, ReplaceWith:="", Wrap:=wdFindContinue, Replace:=wdReplaceOne) = True
        Rng.Collapse wdCollapseStart
        Loop
    End With
End Sub

перед:

enter image description here

после

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...