Копирование из Adobe Reader в Word- текст "столбиком"

[Дмитрий qa]

Бьюсь уже два дня над казалось бы простой задачей. Копирую текст из pdf книги из Adobe Reader в Word 2003. Текст вставляется "столбиком", а нужно чтобы все слова текста были равномерно распределены по всей ширине страниц. Прилагаю скрины как надо и как получается. Раньше у меня в Word был макрос и кнопка. Делел его сам, но как не помню. Два дня рою интернет и не могу найти ответ. Никакие форматирования абзаца не помогают. Вставил готовый макрос из интернета, так он весь текст уродует и приходится вручную форматировать, что при частом повторении копипастов (составляю реферат) делает процесс трудоемким.

[Iska]

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

[Дмитрий qa]

Т.е. вставить pdf файл и файл word?

[Дмитрий qa]

Вот оригиналы.

[Iska]

Дмитрий qa, вряд ли там что-то поможет: не могу сказать наверняка, что в pdf, но в буфер обмена текст попадает уже в виде: одна строка — один абзац. Как в старые добрые времена текстовых редакторов DOS.

Наиболее быстрый путь, на мой взгляд — распознать pdf при помощи ABBYY FineReader, либо попробовать сконвертировать его в приемлемый формат при помощи какого-либо онлайнового конвертера.

[Дмитрий qa]

Спасибо. Еще вопрос, не знаете ли как назначить кнопку к макросу и выбрать для нее иконку в Ворд 2003?

[Iska]

Программно или вручную?

[Дмитрий qa]

Кнопку назначил, Сервис > Настройка > Команды > Макросы > значок макроса перетащить на панель инструментов > правый клик на значке > изменить имя макроса или иконку. Но макрос работает некорректно, приходится править. Вот код.

Sub Macros1 ()
'
Dim sPar As String
Dim par As Paragraph
Dim i As Integer
i = 0
For Each par In ActiveDocument.Paragraphs
If Right(par, 2) = Chr(46) & Chr(13) Then
i = i + 1
Else
If Right(par, 1) = Chr(13) Then
par.Range.Text = Replace(par.Range.Text, Chr(13), " ")
End If
End If
Next par
End Sub

[Iska]

Кнопку назначил, Сервис > Настройка…»
Стало быть — «ручками».

Но макрос работает некорректно, приходится править. Вот код. »
В чём именно проявляется его некорректность?

For Each par In ActiveDocument.Paragraphs»
То бишь, Вы хотите получить один абзац на весь документ? Сомневаюсь.

Лучше так:
Dim i As Long


With Selection.Paragraphs
For i = .Count - 1 To 1 Step -1
With .Item(i).Range
.Collapse Direction:=wdCollapseEnd
.MoveStart Count:=-1
.Delete
.InsertAfter " "
End With
Next
End With

— меняет в выделении все символы абзаца на пробел за исключением последнего. Т.е., Вы выделяете «кривые» абзацы — содержимое будущего единого абзаца, затем исполняете макрос.

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

[Дмитрий qa]

Когда вставляю в Ворд текст из pdf, выделяю его и нажимаю макрос, текст становится полужирный. Причем и выделенный кусок и до начала абзаца выше. Приходится ctrl+z нажимать несколько раз и править вручную. Макрос то работает, но не так как надо.

[Iska]

Макрос работает ровно так, как написано, не более. На выложенном Вами примере (http://forum.oszone.net/post-1977369.html#post1977369) я такого не наблюдал.

Давайте будем очищать всё ручное форматирование в выделении:
Dim i As Long


With Selection.Paragraphs
For i = .Count - 1 To 1 Step -1
With .Item(i).Range
.Collapse Direction:=wdCollapseEnd
.MoveStart Count:=-1
.Delete
.InsertAfter " "
End With
Next

With .Item(1)
.Reset
.Range.Font.Reset
End With
End With

Если будет наблюдаться то же самое — начните с исправления стилей в документе, приведя их к потребному виду.

[chatt]

А я написал такой макрос, который преобразует текст из пдф-файла к человеческому виду, удалит переносы и разрывы строк, + добавит отступ в начале каждого абзаца.
Имеет недостаток - может добавить абзац, если строка заканчивалась точкой, еще может удалить дефис в слове, если перенос этого слова сделан на дефисе.
А так работает как часы,надеюсь пригодится.
Если найдете что-то лучше, сообщите пожалуйста. Часто приходится вставлять в переводчик тексты статей
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "-^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ".^p"
.Replacement.Text = "||||"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "||||"
.Replacement.Text = ".^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.WholeStory
With Selection.ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpace1pt5
.FirstLineIndent = CentimetersToPoints(1.25)
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
End Sub