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

Question

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

Answer 1

找到了。它适用于纯文本文档。

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）。有人知道为什么吗？？

Answer 2

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

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 来重新开始计数

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

VBA WORD How to split doc in X docs?

vba

split

ms-word

outline