VBA WORD Как разделить документ в X документах?

Question

Я хотел бы разделить файл документа с некоторыми единицами в отдельных единицах, взяв уровень 1, обозначенный как знак остановки. Кто-то может помочь мне в этом? Как вы можете видеть, я здесь новичок. Большое спасибо

Answer 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 является глобальным var. Вы также можете сделать Sub, чтобы перезапустить подсчет по вашему желанию.

Answer 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). Кто-нибудь знает, почему?