Макрос для обработки ТВ-программы

[Nord-West]

Добрый день!
Занимаюсь этим грязным делом в первый раз, соответственно возникли проблемы...

Word 2003
Исходники здесь: http://nord-west.pbnet.ru/temp.zip (16 Кб, распаковать в C:/)

Программа приходит в таком виде:
=====================================================
Культура (Сокращенно)

Понедельник, 16 июля
07:00 "Евроньюс" на рус.языке
10:00, 19:30, 23:30 Новости культуры
10:20 "В главной роли..." у Ю.Макарова
10:35, 01:35, 02:50 Программа передач
10:45 Путешествия натуралиста. Вед.- П.Любимцев.
11:15 "Весна". Х/ф
13:00 Достояние республики. Усадьба Волышево.
13:20 "Осенняя история". Х/ф
15:50 "Мир всем!". Художник Елена Волкова.
16:20 Кино - детям. "Тропой бескорыстной любви". Х/ф
17:30 "Утренняя песенка". М/ф.
17:50 "Взаимосвязи". Д/с. 1 с. "Круги по воде".
18:15 Играют лауреаты ХIII Международного конкурса им. П.И.Чайковского.
19:00 Секретные физики. Георгий Флеров.
19:50 Плоды просвещения. "100 величайших открытий". Д/с. 1 с. "Происхождение жизни и ее эволюция".
20:40 "Ада, Адочка, Адуся...".
21:25 "Самый медленный поезд". Х/ф
22:40 Мировые сокровища культуры. "Бремен. Сокровищница вольного города". Д/ф.
23:00 Растущий смысл, или Приключения классики на русской сцене. Авторская программа А.Смелянского. Пер. 5.
23:55 "Чай для двоих". Х/ф.
01:30 Ш.Гуно."Мефисто". Фантазия на темы оперы "Фауст".
01:40 "100 величайших открытий". Д/с. 1 с. "Происхождение жизни и ее эволюция".
02:30 Ж.Массне. Музыка балетного дивертисмента из оперы "Сид".

Вторник, 17 июля
06:30 "Евроньюс" на рус.языке
10:00, 19:30, 23:30 Новости культуры
10:20 "В главной роли..." у Ю.Макарова
10:35, 01:50 Программа передач
10:45 "Взаимосвязи". Д/с. 1 с. "Круги по воде".
...
====================================================

Надо заменить ":" на "." и убрать лишние нули во времени. С этим проблем нет.
Основная задача - получить на выходе один файл вида:
===================
ПОНЕДЕЛЬНИК:
ОРТ
РОССИЯ
ТВЦ
НТВ
И Т.Д.

ВТОРНИК:
ОРТ
РОССИЯ
И Т.Д.
===================
И, собственно, сабж, ход мыслей и багов (создан в ходе тыкания кнопок при включенной записи, проблема в выделении текста в самых последних строках):

Sub Программа()
'
' Программа Макрос
' Макрос записан 25.07.2007 admin
'
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
'[B]Открываем пять файлов в С/темп[/B]
    ChangeFileOpenDirectory "C:\temp\"
    Documents.Open FileName:="tvcen1_s.txt", ConfirmConversions:=False, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", _
        Encoding:=1251
    Documents.Open FileName:="cultura_s.txt", ConfirmConversions:=False, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", _
        Encoding:=1251
    Documents.Open FileName:="ntv_s.txt", ConfirmConversions:=False, ReadOnly _
        :=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate _
        :="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="" _
        , Format:=wdOpenFormatAuto, XMLTransform:="", Encoding:=1251
    Documents.Open FileName:="ort_s.txt", ConfirmConversions:=False, ReadOnly _
        :=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate _
        :="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="" _
        , Format:=wdOpenFormatAuto, XMLTransform:="", Encoding:=1251
    Documents.Open FileName:="russia_s.txt", ConfirmConversions:=False, _
        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", _
        Encoding:=1251
'[B]Последовательно копируем в файл ОРТ содержание всех остальных каналов[/B]
    Selection.WholeStory
    Selection.Copy
    Windows("ort_s.txt").Activate
    Selection.MoveDown Unit:=wdScreen, Count:=26
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.TypeParagraph
    Selection.TypeParagraph
    Windows("tvcen1_s.txt").Activate
    Selection.WholeStory
    Selection.Copy
    Windows("ort_s.txt").Activate
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.TypeParagraph
    Selection.TypeParagraph
    Windows("tvcen1_s.txt").Activate
    Windows("ntv_s.txt").Activate
    Selection.WholeStory
    Selection.Copy
    Windows("ort_s.txt").Activate
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.TypeParagraph
    Selection.TypeParagraph
    Windows("cultura_s.txt").Activate
    Selection.WholeStory
    Selection.Copy
    Windows("ort_s.txt").Activate
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
'[B]Заменяем пустые строки между днями на табуляцию (позже пригодится)[/B]
    With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'[B]просто промежуточный файл///макрос кусочками клеил[/B]
    ActiveDocument.SaveAs FileName:="c:\ort_s.doc", FileFormat:=wdFormatDocument, _
         LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
    Documents.Add DocumentType:=wdNewBlankDocument
    Windows("ort_s.doc").Activate
    Windows("tvcen1_s.txt").Activate
    ActiveWindow.Close
    Windows("cultura_s.txt").Activate
    ActiveWindow.Close
    Windows("ntv_s.txt").Activate
    ActiveWindow.Close
    Windows("russia_s.txt").Activate
    ActiveWindow.Close
    Documents.Add DocumentType:=wdNewBlankDocument
    Application.Keyboard (1033)
    ChangeFileOpenDirectory "C:\"
'[B]Создаем конечный файл[/B]
    ActiveDocument.SaveAs FileName:="programm.doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    Windows("ort_s.doc").Activate
'[B]Ну а вот и наш баг/фича. Поиском выделяю некое слово 
начинающееся с "Понедельник" и заканчивающееся табуляцией. 
Таким образом выделенными оказываются пять фрагментов файла. 
Копируем их в programm.doc и получаем готовую программу на 
понедельник. И по аналогии и все остальные шесть дней. 
Но макрос не выделяет их почему-то. Хотя вручную - прекрасно![/B]
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "Понедельник*^t"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Copy
    Windows("programm.doc").Activate
    Selection.PasteAndFormat (wdPasteDefault)
        
End Sub

 

[nik_smak]

Ответ: Макрос для обработки ТВ-программы

Когда-то давно занимался этим, много искал, добпые люди делились скриптами, что-то сам писал, хотя и не программер. если нужно, могу поделиться своими и чужими наработками по этому поводу.

 

[Nord-West]

Ответ: Макрос для обработки ТВ-программы

Данную проблему уже удалось решить, правда обезьяньим методом.

Поделитесь, если не затруднит, думаю мне помогут ваши наработки.
dima-pposad@rambler.ru