Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Здравствуйте. Я очень часто пишу большие тексты и потом мне нужно разбивать их на строки одинакового количества. На это уходит некоторое время. Есть ли возможность автоматизировать это? Если да, то поделитесь, пожалуйста (если нетрудно, то более подробно, так как я не очень сильно разбираюсь в Word'e и не у кого даже спросить – вот ваш форум нашел, надеюсь, что здесь помогут)
Здравствуйте. Я очень часто пишу большие тексты и потом мне нужно разбивать их на строки одинакового количества. На это уходит некоторое время. Есть ли возможность автоматизировать это? Если да, то поделитесь, пожалуйста (если нетрудно, то более подробно, так как я не очень сильно разбираюсь в Word'e и не у кого даже спросить – вот ваш форум нашел, надеюсь, что здесь помогут)
Что значит одинакового количества? Одинаковое количество символов в абзаце (т.е. отделяете их клавишей
Обрезало текст
Что значит одинакового количества? Одинаковое количество символов в абзаце (т.е. отделяете их клавишей "Enter"?) Пробелы считаются за символы? Нужно более побробно описать вашу ситуацию, а ещё лучше - сбросьте сюда файл ворд с разбивкой на строки и без неё. В идеале - 2 файла ( достаточно одной страницы текста).
Вот без разбивки на строки (сплошной текст): внешняя ссылка
Вот с разбивкой на строки: внешняя ссылка
В последнем варианте весь текст разбит на равное количество строк (18), чтобы не выглядеть как сплошная мешанина.
Попробуйте это.
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Или это ( но это не посмотрит на знак параграфа - т.е. ему не важно будет начало предложения или середина):
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 (Можно создать новый модуль, нажав ПКМ - инсерт модуль. Если не поняли моего объяснения - почитайте как открыть редактор макросов и добавьте код туда.
Спасибо, попробовал первый предложенный вами вариант – работает, но лишь при условии, что весь текст представляет собой цельный кусок и в нем не было отступов между абзацами. Если же будет что-то вроде этого:
то, увы, уже не сработает. 
Есть ли возможность создать такой макрос, который бы работал бы не со всем текстом сразу, а лишь с абзацами? Например, если видит, что в абзаце меньше восемнадцати строк, то он их пропускает и обрабатывает уже следующий?
Приводя такие скриншоты - вы делаете бессмысленную работу, т.к. по ним ничего не понять. Что там под стрелочкой? Знак абзаца или просто отступ? Вам не мешало бы ознакомиться с терминологией ворд, чтобы внятно объяснить свои мысли. Есть понятие междустрочный интервал, но на количесво символов или строк он не влияет. Есть понятие абзаца - нажатие клавиши Enter. Просил сбросить пример документа - вы сбросили и получили на него макрос. Почему бы не сбросить документ, который действительно будет обрабатываться? Или похожий хотя бы по форматированию.
Хорошо, вот пример: внешняя ссылка
Использую макрос, указанный в первом варианте - он разбивает текст, но уже не по 18 строк. Если же текст до этого никак не разбивался, а был написан сплошной мешаниной без Enter, то все нормально.
Хорошо, вот пример: внешняя ссылка
Использую макрос, указанный в первом варианте - он разбивает текст, но уже не по 18 строк. Если же текст до этого никак не разбивался, а был написан сплошной мешаниной без Enter, то все нормально.
Хорошо, значит вы хотите сначала убрать лишние пустые абзацы, а потом разбить по 18 строк, верно?
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Ну, суть в том, что я пишу для блогов а-ля ЖЖ. Там есть вступление – оно может быть меньше этих пресловутых восемнадцати строк. Все остальное это текст, который должен быть поделен на равные куски для более удобного визуального восприятия. Я попробовал использовать третий вариант, но он разбивает на хаотичные куски (например, второй кусок там вышел на двенадцать строк, а третий – на семнадцать). Мне же нужно вступление (его я сам отделяю от остального текста), а остальной текст – по восемнадцать строк в каждом куске.
Вы опять делаете это. Опять у вас новое ТЗ. Теперь у вас появилось введение, которое трогать не надо и опять неясно, нужно ли последующий текст делить заново на куски, убирая предыдущие знаки абзацев, или нет. Вырежьте введение перед запуском макроса, а после завершения его работы - вставьте обратно перед текстом.
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Вот этот код вам нужен. Подправил, но вырезать введение собственноручно
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться