1 Тема от extas

  • extas
  • рядовой
  • Неактивен
  • Зарегистрирован: 15.11.2016
  • Сообщений: 1

Тема: Разделить документ и сохранить с именем из фрагмента текста

Добрый день.
Используя инструменты Рассылки я создаю много однотипных документов. Word их сохраняет все в один большой файл и вставляет разрывы разделов со следующей страницы в конце каждого раздела. Стоит задача - разделить этот большой файл на много мелких в местах разрыв разделов и потом сохранить каждый мелкий файл с уникальным именем. Имя файла должно совпадать с первой строкой текста в файле.

2 Ответ от Fck_This

  • Разделить документ и сохранить с именем из фрагмента текста
  • Fck_This
  • генерал-полковник
  • Неактивен
  • Откуда: Минск, Беларусь
  • Зарегистрирован: 13.07.2016
  • Сообщений: 648
  • Поблагодарили: 97

Re: Разделить документ и сохранить с именем из фрагмента текста

extas пишет:

Добрый день.
Используя инструменты Рассылки я создаю много однотипных документов. Word их сохраняет все в один большой файл и вставляет разрывы разделов со следующей страницы в конце каждого раздела. Стоит задача - разделить этот большой файл на много мелких в местах разрыв разделов и потом сохранить каждый мелкий файл с уникальным именем. Имя файла должно совпадать с первой строкой текста в файле.


Для начала вам нужно выбрать кусок текста, который будете переносить в другой документ.

Sub AWordCounter()
Dim dThatDoc As Document
Dim dNewDoc As Document
Dim sFullName, sName As String
sFullName = Word.Application.ActiveDocument.FullName
sName = Word.Application.ActiveDocument.Name
Set dThatDoc = Word.Application.ActiveDocument
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "^m"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
        Do While .Execute = True
            Selection.Range.Delete
            Selection.TypeBackspace
            dThatDoc.Range(0, Selection.End).Cut
            Set dNewDoc = Word.Application.Documents.Add(Visible:=False)
            dNewDoc.Activate
            Selection.Paste
            'Тут надо применить тот макрос, что содержится в приложенной ниже теме
            dThatDoc.Activate
        Loop
'Если после последнего куска текста нет разрыва страницы, то надо раскомментить код ниже
    dThatDoc.Range(0, dThatDoc.Characters.Count).Cut
    Set dNewDoc = Word.Application.Documents.Add(Visible:=False)
            dNewDoc.Activate
            Selection.Paste
    'Снова код сохраняющий документ с именем = первойстроке
    dThatDoc.Activate
End Sub

Для сохранения документа с именем = первой строке я уже писал макрос. Посмотрите здесь
http://wordexpert.ru/forum/viewtopic.php?id=2999

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871