Макрос word удалить абзацы в word

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

Option Explicit     'указание интерпретатору BASIC проверять, что данные объявлены
 
Sub GetOutParagraphsWithUserDefindContent()
Const UDC = "этот абзац я не хочу" 'текст, наличие которого грохает абзац
    Dim i As Long           'счётчик абзацев
    Dim oPars As Object     'переменная для работы с абзацами документа
    Dim oPar As Object      'переменная для работы с каждым абзацем документа
    
    With ActiveDocument 'работаем в активном документе Word
        Set oPars = .Paragraphs
        'переменная oPar стала семейством ActiveDocument.Paragraphs
        .Range.Find.Execute Chr(11), replacewith:=Chr(13), Replace:=wdReplaceAll
        'заменили разрывы строк (код 11) символами абзацев (код 13)
    End With
 
    'Переберём все абзацы и удалим те, в которых есть данный текст
    For Each oPar In oPars
        i = i + 1
    
        If oPars(i).Range.Text Like "*" & UDC & "*" Then
            oPars(i).Range.Delete 'удалили весь абзац, где был текст константы UDC
            i = i - 1       'ненужный абзац удалён - счёт возвращаем назад на единицу
        End If
    Next
End Sub

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

Sub GetOutParagraphsWithUserDefindContent_131222_1411()
dim UDC as string
udc=selection.range.text  'текст, наличие которого грохает абзац
Dim i As Long     'счётчик абзацев
 
With ActiveDocument 'работаем в активном документе Word
    i = .Paragraphs.Count
    '''''''''''''''''''''''''''''''''''''''''это незаконно''''''''
    '.Range.Find.Execute Chr(11), replacewith:=Chr(13), Replace:=wdReplaceAll
    'заменили разрывы строк (код 11) символами абзацев (код 13)
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Переберём все абзацы и удалим те, в которых есть данный текст
    Do While i > 0
        If LCase(.Paragraphs(i).Range.Text) Like "*" & LCase(UDC) & "*" Then
             Debug.Print i, .Paragraphs(i).Range.Text
             .Paragraphs(i).Range.Delete 'удалили весь абзац, где был текст константы UDC
             'ненужный абзац удалён
        End If
        i = i - 1
    Loop
 
End With
 
 
End Sub