Макрос для worda

[viter.alex]

Избавиться от «неправильных» абзацев можно ещё таким способом:

Sub MakeNormalParagraphs()
  Dim oDoc As Document
  Const PARAGRAPH_DELIMITER As String = "@#$%"
  
  Set oDoc = ActiveDocument
  'Замена псевдоабзацев на нормальные абзацы
  With oDoc.Range.Find
    .Text = "^0013"
    .Replacement.Text = PARAGRAPH_DELIMITER
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
  With oDoc.Range.Find
    .Text = PARAGRAPH_DELIMITER
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
  End With
End Sub

А по теме предложу такой вариант

Sub ArrangeScheduleTime()
  Dim oParFirst As Paragraph 'Абзац с текущей передачей
  Dim oParNext As Paragraph 'Абзац со следующей передачей
  Dim sTimeFirst As String 'Время текущей передачи
  Dim sIssueFirst As String 'Название текущей передачи
  Dim sTimeNext As String 'Время следующей передачи
  Dim sIssueNext As String 'Название следующей передачи
  Dim oRng As Range 'Диапазон абзаца текущей передачи
  
  Set oParFirst = ActiveDocument.Paragraphs.First
  Do Until oParFirst Is Nothing
    Set oRng = oParFirst.Range
    sTimeFirst = Mid(oParFirst.Range.Text, 1, InStr(oParFirst.Range.Text, " "))
    If IsDate(sTimeFirst) Then
      sIssueFirst = Trim(Mid(oParFirst.Range.Text, Len(sTimeFirst)))
      sTimeFirst = Trim(sTimeFirst)
      Set oParNext = oParFirst.Next
      Do Until oParNext Is Nothing
        sTimeNext = Mid(oParNext.Range.Text, 1, InStr(oParNext.Range.Text, " "))
        If IsDate(sTimeNext) Then
          sIssueNext = Trim(Mid(oParNext.Range.Text, Len(sTimeNext)))
          sTimeNext = Trim(sTimeNext)
          If sIssueNext = sIssueFirst Then
            sTimeFirst = sTimeFirst & ", " & sTimeNext
            oParNext.Range.Delete
          Else
            Set oParNext = oParNext.Next
          End If
        Else
          Set oParNext = oParNext.Next
        End If
      Loop
      ActiveDocument.Range(oRng.Start, oRng.Start + oRng.MoveStartUntil(" ") - 1).Text = sTimeFirst
      Set oParFirst = oParFirst.Next
    Else
      Set oParFirst = oParFirst.Next
    End If
    DoEvents
  Loop
End Sub

[foreytor]

Красиво!
В связи с этим кодом у меня всплыл вопрос, который будет небесполезен и Prince1991.
Если в списке происходит сбой хронологии, то его (весь или выделенный фрагмент - "Selection") нужно предварительно отсортировать. Эта стандартная задача (сортировка) имеет классическое решение, или каждый упражняется в меру своей испорченности?
Я, например, привык передавать такой фрагмент в массив, и далее, через функции сравнения и обмена "опускаю" больший элемент "вниз", каждый раз уменьшая счетчик на единичку. Да еще флажок ставлю - вдруг повезет раньше окончания полного цикла Но это очень старый метод. И не очень красивый Может быть современный VBA позволяет усовершенствовать процесс?

[viter.alex]

А почему нельзя воспользоваться встроенной сортировкой?

[Prince1991]

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

Я немного усовершенствовал программу от foreytor.

В приложенном документе запуск по F6. Просмотр кода — по Alt-F11 (отличие только в интерфейсе; как вам?..).

Да примерно именно так и хотел, но такой вопрос, как применить этот макрос например только к понедельнику, нам присылают документ на целую неделю, и получается мне нужно создавать семь документов (семь дней в неделю), вставлять текст и применять этот макрос? Нельзя ли просто выделить текст, то есть типа макрос будет работать только в выделенном тексте?
Все таки за макрос, огромное спасибо, хоть немного, но понял в чем смысл, еще раз спасибо.

[Sasha_Smirnov]

Да конечно же можно. Пока, извините, некогда: компьютер не мой.

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

To Sasha_Smirnov
"программа" - это звучит гордо!
Вообще-то это даже не макрос, а набросок. Вариант, который можно рассмотреть для решения проблемы.
Но, конечно, интерфейс ему обязательно будет нужен, тут я согласен на все 100% !

Ну да, это не Готская программа! Но всё же замечу, что 12 лет назад результат её работы сэкономил бы редакции (работодателю, разумеется) около $100 — столько, со слов начальства, стоила обработанная, уже готовая к печати TV-программа.

[viter.alex]

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

…как применить этот макрос например только к понедельнику, нам присылают документ на целую неделю, и получается мне нужно создавать семь документов (семь дней в неделю), вставлять текст и применять этот макрос? Нельзя ли просто выделить текст, то есть типа макрос будет работать только в выделенном тексте?…

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

[foreytor]

Сообщение от viter.alex

А почему нельзя воспользоваться встроенной сортировкой?

Я то думал, стандартная функция ".Sort" применима только к спискам и таблицам. А оказывается есть и "Selection.Sort".
Чего ради было прописывать этот пункт в "Таблицы".

Спасибо за подсказку!

[Sasha_Smirnov]

А есть ещё Вид→Структура, а там кнопка АЯ↓ (сортировать уровни).