1

Тема: Разбивка на строки

Здравствуйте. Я очень часто пишу большие тексты и потом мне нужно разбивать их на строки одинакового количества. На это уходит некоторое время. Есть ли возможность автоматизировать это? Если да, то поделитесь, пожалуйста (если нетрудно, то более подробно, так как я не очень сильно разбираюсь в Word'e и не у кого даже спросить – вот ваш форум нашел, надеюсь, что здесь помогут)

2

Re: Разбивка на строки

Wilx пишет:

Здравствуйте. Я очень часто пишу большие тексты и потом мне нужно разбивать их на строки одинакового количества. На это уходит некоторое время. Есть ли возможность автоматизировать это? Если да, то поделитесь, пожалуйста (если нетрудно, то более подробно, так как я не очень сильно разбираюсь в Word'e и не у кого даже спросить – вот ваш форум нашел, надеюсь, что здесь помогут)

Что значит одинакового количества? Одинаковое количество символов в абзаце (т.е. отделяете их клавишей

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

3

Re: Разбивка на строки

Обрезало текст
Что значит одинакового количества? Одинаковое количество символов в абзаце (т.е. отделяете их клавишей "Enter"?) Пробелы считаются за символы? Нужно более побробно описать вашу ситуацию, а ещё лучше - сбросьте сюда файл ворд с разбивкой на строки и без неё. В идеале - 2 файла ( достаточно одной страницы текста).

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

4

Re: Разбивка на строки

Вот без разбивки на строки (сплошной текст): внешняя ссылка

Вот с разбивкой на строки: внешняя ссылка

В последнем варианте весь текст разбит на равное количество строк (18), чтобы не выглядеть как сплошная мешанина.

Разбивка на строки

5

Re: Разбивка на строки

Попробуйте это.

Sub Разбивка()
Dim oDoc As Document
Set oDoc = ActiveDocument
Selection.HomeKey Unit:=wdStory
iChar = Fix(oDoc.Characters.Count / 1010)
For i = 1 To iChar
    Selection.MoveRight Unit:=wdCharacter, Count:=1010
    Selection.Expand Unit:=wdParagraph
    Selection.Collapse Direction:=wdCollapseEnd
    Selection.InsertAfter vbCr
    Selection.Collapse Direction:=wdCollapseEnd
Next i
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

6

Re: Разбивка на строки

Или это ( но это не посмотрит на знак параграфа - т.е. ему не важно будет начало предложения или середина):

Sub РазбивкаДва()
Dim oDoc As Document
Set oDoc = ActiveDocument
Selection.HomeKey Unit:=wdStory
iChar = Fix(oDoc.Characters.Count / 1010)
For i = 1 To iChar
    Selection.MoveDown Unit:=wdLine, Count:=18
    Selection.InsertAfter vbCr
    Selection.Collapse Direction:=wdCollapseEnd
Next i
End Sub

Чтобы вставить макрос - нажмите Вид - Макросы - Макросы - создать или изменить и вставьте этот код в окно проекта Normal.dot (Можно создать новый модуль, нажав ПКМ - инсерт модуль. Если не поняли моего объяснения - почитайте как открыть редактор макросов и добавьте код туда.

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

7

Re: Разбивка на строки

Спасибо, попробовал первый предложенный вами вариант – работает, но лишь при условии, что весь текст представляет собой цельный кусок и в нем не было отступов между абзацами. Если же будет что-то вроде этого:

Разбивка на строки 

то, увы, уже не сработает. sad Есть ли возможность создать такой макрос, который бы работал бы не со всем текстом сразу, а лишь с абзацами? Например, если видит, что в абзаце меньше восемнадцати строк, то он их пропускает и обрабатывает уже следующий?

8

Re: Разбивка на строки

Приводя такие скриншоты - вы делаете бессмысленную работу, т.к. по ним ничего не понять. Что там под стрелочкой? Знак абзаца или просто отступ? Вам не мешало бы ознакомиться с терминологией ворд, чтобы внятно объяснить свои мысли. Есть понятие междустрочный интервал, но на количесво символов или строк он не влияет. Есть понятие абзаца - нажатие клавиши Enter. Просил сбросить пример документа - вы сбросили и получили на него макрос. Почему бы не сбросить документ, который действительно будет обрабатываться? Или похожий хотя бы по форматированию.

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

9

Re: Разбивка на строки

Хорошо, вот пример: внешняя ссылка

Использую макрос, указанный в первом варианте - он разбивает текст, но уже не по 18 строк. Если же текст до этого никак не разбивался, а был написан сплошной мешаниной без Enter, то все нормально.

10

Re: Разбивка на строки

Wilx пишет:

Хорошо, вот пример: внешняя ссылка

Использую макрос, указанный в первом варианте - он разбивает текст, но уже не по 18 строк. Если же текст до этого никак не разбивался, а был написан сплошной мешаниной без Enter, то все нормально.

Хорошо, значит вы хотите сначала убрать лишние пустые абзацы, а потом разбить по 18 строк, верно?

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

11

Re: Разбивка на строки

Sub Разбивка()
Dim oDoc As Document
Set oDoc = ActiveDocument
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Execute FindText:="^0013{2;}", Forward:=True, Wrap:=wdFindContinue, ReplaceWith:="^0013", Replace:=wdReplaceAll
End With
Application.ScreenRefresh
Selection.HomeKey Unit:=wdStory
iChar = Fix(oDoc.Characters.Count / 1010)
For i = 1 To iChar
    Selection.MoveDown Unit:=wdLine, Count:=18
    Selection.InsertAfter vbCr
    If Selection.Range.Text = Chr(13) And Selection.Range.Characters(1).Previous <> Chr(13) Or _
        Selection.Range.Text = Chr(13) And Selection.Range.Characters(1).Next <> Chr(13) Then
        Selection.Range.Text = Chr(13) & Chr(13)
    End If
    Selection.Collapse Direction:=wdCollapseEnd
Next i
Do While oDoc.Characters.Last = Chr(13) And oDoc.Characters.Last.Previous = Chr(13)
    oDoc.Characters.Last.Previous.Delete
    Application.ScreenRefresh
Loop
End Sub
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

12

Re: Разбивка на строки

Ну, суть в том, что я пишу для блогов а-ля ЖЖ. Там есть вступление – оно может быть меньше этих пресловутых восемнадцати строк. Все остальное это текст, который должен быть поделен на равные куски для более удобного визуального восприятия. Я попробовал использовать третий вариант, но он разбивает на хаотичные куски (например, второй кусок там вышел на двенадцать строк, а третий – на семнадцать). Мне же нужно вступление (его я сам отделяю от остального текста), а остальной текст – по восемнадцать строк в каждом куске.

внешняя ссылка

13

Re: Разбивка на строки

Вы опять делаете это. Опять у вас новое ТЗ. Теперь у вас появилось введение, которое трогать не надо и опять неясно, нужно ли последующий текст делить заново на куски, убирая предыдущие знаки абзацев, или нет. Вырежьте введение перед запуском макроса, а после завершения его работы - вставьте обратно перед текстом.

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

14

Re: Разбивка на строки

Sub Разбивка()
Dim oDoc As Document
Set oDoc = ActiveDocument
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Execute FindText:="^0013{2;}", MatchWildcards:=True, Forward:=True, Wrap:=wdFindContinue, ReplaceWith:="^0013", Replace:=wdReplaceAll
End With
Application.ScreenRefresh
Selection.HomeKey Unit:=wdStory
iChar = Fix(oDoc.Characters.Count / 1010)
For i = 1 To iChar
    If i = iChar Then
    If oDoc.Characters.Count - oDoc.Range(1, Selection.Start).Characters.Count < 1010 Then GoTo FixIt
    End If
    Selection.MoveDown Unit:=wdLine, Count:=18
    Selection.InsertAfter vbCr
    If Selection.Range.Text = Chr(13) And Selection.Range.Characters(1).Previous <> Chr(13) Or _
        Selection.Range.Text = Chr(13) And Selection.Range.Characters(1).Next <> Chr(13) Then
        Selection.Range.Text = Chr(13) & Chr(13)
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
    Selection.Collapse Direction:=wdCollapseEnd
Next i
FixIt:
Do While oDoc.Characters.Last = Chr(13) And oDoc.Characters.Last.Previous = Chr(13)
    oDoc.Characters.Last.Previous.Delete
    Application.ScreenRefresh
Loop
End Sub

Вот этот код вам нужен. Подправил, но вырезать введение собственноручно

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