VBA WORD Comment diviser doc dans les documents X?

Question

Je voudrais diviser un fichier doc avec quelques unités dans des unités individuelles, prenant Level 1 Outlined comme marque d'arrêt. Quelqu'un pourrait m'aider avec ça? Comme vous pouvez le voir, je suis un débutant total ici. Merci beaucoup

Answer 1

Eh bien, je l'ai fait. Ce n'est pas exactement et processus d'auto-split, mais il fait la chose:

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 est défini comme variable globale. Vous pouvez également faire un peu de Sub pour redémarrer le comptage comme vous le souhaitez

Answer 2

Trouvé ceci. Cela fonctionnera pour les documents en texte seul.

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 

Mais je dois le faire avec le contenu complet, tableaux, images, etc.

Je travaille sur cela aussi:

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 

Ce travail la première fois, Mais je ne sais pas comment la recherche itère entre les éléments trouvés. Après que cela fonctionne la première fois, c.end n'augmente pas, il est toujours à la première position (par exemple, 3106). Est-ce que quelqu'un sait pourquoi?