☰

Word：用回车符替换自动换行符

tag-icon • tag-icon microsoft-word vba
Word：用回车符替换自动换行符

我遇到了一个相当不寻常的问题。我有一个 MS Word 文件（由 Adob​​e 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 文档链接

谢谢！

彼得

答案1

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

答案2

谢谢 Máté，它没有提供解决方案，但帮助我找到了正确的方向。实际上，由于它很棘手，因此它只是对手动执行任务时选择行为的简单分析。您的解决方案假设段落中只有一个自动行结束，但有些段落使用了超过 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

相关内容