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

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Microsoft Office (Word, Excel, Outlook и т.д.) (http://forum.oszone.net/forumdisplay.php?f=115)

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

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

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

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

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

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

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

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

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

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

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

Цитата:

Цитата Дмитрий qa

Кнопку назначил, Сервис > Настройка…»

Стало быть — «ручками».

Цитата:

Цитата Дмитрий qa

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

В чём именно проявляется его некорректность?

Цитата:

Цитата Дмитрий qa

Код:

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

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

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

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

Макрос работает ровно так, как написано, не более. На выложенном Вами примере я такого не наблюдал.

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

Код:

    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

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

А я написал такой макрос, который преобразует текст из пдф-файла к человеческому виду, удалит переносы и разрывы строк, + добавит отступ в начале каждого абзаца.
Имеет недостаток - может добавить абзац, если строка заканчивалась точкой, еще может удалить дефис в слове, если перенос этого слова сделан на дефисе.
А так работает как часы,надеюсь пригодится.
Если найдете что-то лучше, сообщите пожалуйста. Часто приходится вставлять в переводчик тексты статей

Код:

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