Слово: заменить автоматические разрывы строк на возврат каретки

Question

У меня довольно необычная проблема. У меня есть файл MS Word (созданный Adobe Acrobat, оригинал был PDF), который содержит несколько текстовых полей. Содержимое этих текстовых полей необходимо проанализировать, чтобы я мог импортировать его в базу данных. Текст в документе PDF отформатирован в 2 столбца. К сожалению, преобразование файлов в Adobe Acrobat не вставляет возврат каретки после каждой строки. В результате, когда DOCX сохраняется в виде текстового файла, текст запутывается. Преобразование файлов в Word, опция "добавление конца строки", не работает для текстовых полей или текстовых фреймов. Преобразование всех текстовых полей в тексте абзаца также портит текст. На мой взгляд, это лучший способ решить этот макрос vba, который распознает каждый автоматический конец строки в любом текстовом поле в документе и вставляет возврат каретки. Тем не менее, я попытался сделать это с помощью предопределенной закладки "\line", но, похоже, это не работает и в текстовых полях. Я продолжаю получать сообщение об ошибке "Объект удален", который не возникает, если выбран только текст абзаца (не в текстовом поле).

Sub ChangeAutoLineBreaks()
Dim r As Word.Range

Set r = Selection.Range

Selection.Collapse direction:=wdCollapseStart
Do Until Selection.End > r.End
  Selection.Bookmarks("\Line").Select
  If Right(Selection, 1) = " " Then
      Selection.SetRange Selection.End - 1, Selection.End
      Selection.Delete
      Selection.Text = vbCr
      Selection.Bookmarks("\Line").Select
      Selection.Collapse direction:=wdCollapseStart
  End If
  Selection.MoveDown wdLine, 1, False
Loop

' reselect our original selection
r.Select
Set r = Nothing
End Sub

Я пробовал другие инструменты миграции файлов (pdf> docx или pdf> txt), но я получил лучший результат, если преобразование файлов выполняется с использованием MS Word в качестве обходного пути.

Кто-нибудь есть какие-нибудь советы, как я могу заставить это работать для меня в Word?

Снимок экрана, описывающий проблему

Ссылка на документ DOCX

Спасибо!

Питер

Answer 1

Спасибо, это не принесло решения, но помогло мне в правильном направлении. На самом деле и потому, что это сложно, это был простой анализ поведения выборов, когда задача была выполнена вручную. Ваше решение предполагало, что в абзаце был только один автоматический конец строки, но были абзацы, использующие более 2 строк. Вот как я это решил.

    Dim aShape As Shape
Dim aParagraph As Paragraph

On Error Resume Next
Application.ScreenUpdating = False

For Each aShape In ActiveDocument.Shapes
    If aShape.Type = msoTextBox Then
        For Each aParagraph In aShape.TextFrame.TextRange.Paragraphs
            aParagraph.Range.Select
            Selection.Collapse direction:=wdCollapseStart
            Selection.HomeKey Unit:=wdLine
            Selection.EndKey Unit:=wdLine
            Do Until Asc(Selection.Text) = 13
                Selection.InsertAfter vbCrLf
                Selection.MoveDown wdLine, 1
                Selection.EndKey Unit:=wdLine
            Loop
        Next
    End If
Next aShape

Application.ScreenUpdating = True

Answer 2

В Word нет объекта для обозначения концов строк в абзацах, поэтому это действительно сложная задача.

В качестве обходного пути вы можете:

• выбор места в начале каждого абзаца
• перемещение сделано на одну строку (как нажатие стрелки вниз)
• вернитесь на один символ назад и проверьте, является ли это разрывом абзаца
  • если нет, то добавь

Ниже пример кода делает этот процесс для одного абзаца, просто нужно перебрать все абзацы в ваших текстовых полях (я проверял, это работает и с текстовыми полями).

    Selection.Paragraphs(1).Range.Select
    Selection.Collapse wdCollapseStart
    Selection.MoveDown wdLine, 1
    Selection.MoveLeft wdCharacter, 1, True
    If Asc(Selection.Text) <> 13 Then
        Selection.InsertAfter Chr(13)
    End If