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

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

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

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

   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

5. Збережіть макрос.
6. Відкрийте «Макроси» (Macros). «Alt» + «F8» або так:
   
7. Виберіть новий макрос ClearDoc і натисніть Run щоб запустити його.
   
8. Перевірте документ і закиньте донат на ЗСУ.

Користуюючись нагодою, хочу звернути увагу на розкладку з тире, наголосом і ла́пками: розкладка