Нік Орач: Перетворюємо списки на діалоги

Маю подарунок для редакторів.

Кажуть, що деякі автори часто присилають текст, де діалог зроблено маркованим списком. Перетворити такий список у нормальний текст і розставити тире — та ще морока. Але я маю рішення — макрос для візуал бейсіка у ворді. Ну, і заразом чистимо пробіли та наводимо лад із рисками та тире.

Відкрийте документ з маркованими списками з діалогами у Microsoft Word.
Відкрийте Visual Basic Editor. «Alt» + «F11» або так:
У Visual Basic Editor виберіть Normal у списку проектів (Project) в лівій частині екрана.

Вставте код у вікно коду макросу:

Sub ConvertDialogListsToText(dashesArray As Variant)
    Dim para As Paragraph
    Dim i As Long
    
    ' Loop through each paragraph in the document
    For i = ActiveDocument.Paragraphs.Count To 1 Step -1
        Set para = ActiveDocument.Paragraphs(i)
      
        ' Check if the paragraph is a list item with a dash or hyphen bullet
        If (para.range.ListFormat.listType = wdListBullet Or para.range.ListFormat.listType = wdListOutlineNumbering) _
            And (InStr(1, Join(dashesArray, ""), para.range.ListFormat.ListString) > 0) Then
            
            ' Get the text of the paragraph without the bullet
            para.range.ListFormat.RemoveNumbers
            para.range.Text = ChrW(8212) & " " & Mid(para.range.Text, 1)
        End If
    Next i
End Sub
Sub MergeSpaces()
Application.ScreenUpdating = False
With ActiveDocument.range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "([^s ])@[^s ]"
    .Replacement.Text = " "
    .Forward = True
    .Format = False
    .wrap = wdFindContinue
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub
Sub ReplaceDashes(dashesArray As Variant)
 ' Replace dashes and space with en dash and nonbreaking space
    For Each dash In dashesArray
        With ActiveDocument.Content.Find
            .Text = " " & dash
            .Replacement.Text = ChrW(160) & ChrW(8212)
            .Forward = True
            .wrap = wdFindStop
            .Execute Replace:=wdReplaceAll
        End With
        With ActiveDocument.Content.Find
            .Text = dash & " "
            .Replacement.Text = ChrW(8212) & " "
            .Forward = True
            .wrap = wdFindStop
            .Execute Replace:=wdReplaceAll
        End With
    Next dash
End Sub
Sub RightTrim()
    With ActiveDocument.Content.Find
        .Text = " ^p"
        .Replacement.Text = "^p"
        .Forward = True
        .wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub
Sub LeftTrim()
     With ActiveDocument.Content.Find
        .Text = "^p "
        .Replacement.Text = "^p"
        .Forward = True
        .wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub
Sub RemoveFirstSpace()
    Dim firstChar As range
    Set firstChar = ActiveDocument.range.Characters(1)
    If firstChar.Text = " " Then
        firstChar.Delete
    End If
End Sub
Sub ClearDoc()
    Dim dashesArray As Variant
    dashesArray = Array(ChrW(45), ChrW(8212), ChrW(8211), ChrW(8209), ChrW(8209), ChrW(8722), ChrW(8210), ChrW(32), ChrW(8259))
    Call ConvertDialogListsToText(dashesArray)
    Call MergeSpaces
    Call RightTrim
    Call LeftTrim
    Call ReplaceDashes(dashesArray)
    Call RemoveFirstSpace
End Sub