VBA WORD 如何在 X 文档中拆分文档？答案

【问题标题】：VBA WORD How to split doc in X docs?VBA WORD 如何在 X 文档中拆分文档？
【发布时间】：2015-03-05 16:53:39
【问题描述】：

我想将包含一些单元的 doc 文件拆分为单独的单元，将 Level 1 Outlined 作为停止标记。有人可以帮我解决这个问题吗？如您所见，我在这里完全是新手。非常感谢

【问题讨论】：

仍在等待一些帮助以找到完整的解决方案。提前致谢

【解决方案1】：

嗯，我做到了。这不完全是自动拆分过程，但它确实做到了：

Sub CutSelect()
    Dim ruta As String
    Selection.Cut

    ruta = ActiveDocument.Path
    Dim doc As Document
            x = x + 1
            Set doc = Documents.Add
            Selection.Paste
            '-----You can add some other things to do here
            doc.SaveAs ruta & "\" & "Tema " & Format(x, "0")
            '-----So here
            doc.Close True

End Sub

X 设置为全局变量。您也可以根据需要做一些 Sub 来重新开始计数

【讨论】：

...yyyep。我在保存前做了 5 个程序，在解决 OCR 问题后做了 7 个程序。我仍在等待有关自动程序的帮助。但就目前而言，这工作正常。我知道这是一个便宜的解决方案，但至少您可以选择并自动剪切/格式化/保存选择。

【解决方案2】：

找到这个。它适用于纯文本文档。

Option Explicit

Sub SplitNotes(delim As String, strFilename As String)
    Dim doc As Document
    Dim arrNotes
    Dim I As Long
    Dim x As Long
    Dim Response As Integer
    Dim ruta As String
    ruta = ActiveDocument.Path

    'Vector con los delimitadores
    arrNotes = Split(ActiveDocument.Range, delim)

    Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections. Do you wish to proceed?", 4)
    If Response = 7 Then Exit Sub
    For I = LBound(arrNotes) To UBound(arrNotes)
        If Trim(arrNotes(I)) <> "" Then
            x = x + 1
            Set doc = Documents.Add
            doc.Range = arrNotes(I)
            doc.SaveAs ruta & "\" & strFilename & Format(x, "0")
            doc.Close True
        End If
    Next I
End Sub


Sub test()
     '      delimiter & filename
    SplitNotes "///", "Tema "
End Sub

但我需要对完整的内容、表格、图像等进行此操作。

我也在做这个：

Sub TESTSplitNotes(delim As String, strFilename As String)
    Dim doc As Document
    Dim arrNotes
    Dim I As Long

    Dim Response As Integer
    Dim ruta As String
    Dim p As Paragraph
    ruta = ActiveDocument.Path
    Dim c As Range
    Set c = ActiveDocument.Content
     With c.Find
        .Text = delim & "(*)" & delim
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Replacement.Text = ""
    End With
    '.Select
    c.Find.Execute
While c.Find.Found
Debug.Print c.Start
Debug.Print c.End
'COPY CONTENT
        Set r = ActiveDocument.Range(Start:=ini, End:=c.End - 3)
        r.Select
        Debug.Print ActiveDocument.Range.End
        Selection.Copy
        x = x + 1
        Set doc = Documents.Add
        Selection.Paste
'PASTE CONTENT
        doc.SaveAs ruta & "\" & strFilename & Format(x, "0")
        doc.Close True
        ini = c.End - 3
Wend
End Sub

这是第一次工作，但我不知道搜索如何在找到的元素之间进行迭代。第一次工作后，c.end 没有增加，它仍然在第一个位置（例如，3106）。有人知道为什么吗？？

【讨论】：

因为您使用的是文档中的所有范围，
如果您使用 find 找到了您要查找的内容，则必须更改（增加）起点