Macro pour un-à-plusieurs fractionnement des documents Word

Il m'a fallu un certain temps pour comprendre comment faire, même avec l'article base de connaissances.

Tout d'abord, vous avez besoin de mettre de la macro dans la Normale.dotm Ouvrir... C:\Users\Yourname\AppData\Roaming\Microsoft\Templates\Normal.dotm en un Mot, appuyez sur Alt-F11 et collez le texte suivant dans Module1:

    Sub BreakOnSection()
   Application.ScreenUpdating = False 'Makes the code run faster and reduces screen flicker a bit.

   ' Used to set criteria for moving through the document by section.
   Application.Browser.Target = wdBrowseSection
   strBaseFilename = ActiveDocument.Name
   On Error GoTo CopyFailed

   'A mail merge document ends with a section break next page.
   'Note: Document may or may not end with a section break,
   For I = 1 To ActiveDocument.Sections.Count

      'Select and copy the section text to the clipboard.
      ActiveDocument.Bookmarks("\Section").Range.Copy

      'Create a new document to paste text from clipboard.
      Documents.Add
      Selection.Paste
      DocNum = DocNum + 1
      strNewFileName = Replace(strBaseFilename, ".do", "_" & Format(DocNum, "000") & ".do")
     ActiveDocument.SaveAs "C:\Destination\" & strNewFileName
     ActiveDocument.Close
      ' Move the selection to the next section in the document.
     Application.Browser.Next
   Next I
   Application.Quit SaveChanges:=wdSaveChanges
   End

CopyFailed:
    'MsgBox ("No final Section Break in " & strBaseFilename)
    Application.Quit SaveChanges:=wdSaveChanges
    End
End Sub

Enregistrer la Normale.dotm fichier.

L'exécution de ce code permettra de diviser un document composé de plusieurs sections dans plusieurs documents dans le C:\Destination annuaire et puis fermez Word.

Vous pouvez l'exécuter à partir de la ligne de commande via:

"c:\Program Files\Microsoft Office\Office12\WINWORD.EXE" /mBreakOnSection "C:\Path to Source\Document with multiple sections.doc"

De traiter tous les .doc fichiers dans un répertoire, créez un fichier de commandes comme suit, et de l'exécuter:

@ECHO off
set "dir1=C:\Path to Source"
echo running
FOR %%X in ("%dir1%\*.doc") DO "c:\Program Files\Microsoft Office\Office12\WINWORD.EXE" /mBreakOnSection "%%~X"
echo Done
pause

OriginalL'auteur user998303

Split document word par compteur de page, par exemple, utiliser 50 à étapes

Sub Spliter(PartStep)
If IsEmpty(PartStep) Or Not IsNumeric(PartStep) Then
Exit Sub
End If
Dim i, s, e, x As Integer
Dim rgePages As Range
Dim MyFile, LogFile, DocFile, DocName, MyName, MyPages, FilePath, objDoc
Set fso = CreateObject("scripting.filesystemobject")
Selection.GoTo What = wdGoToLine, Which = wdGoToFirst
Application.ScreenUpdating = False
ActiveDocument.Repaginate
MyPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
DocFile = ActiveDocument.FullName
intPos = InStrRev(DocFile, ".")
MyName = Left(DocFile, intPos - 1)
If Not fso.folderexists(MyName) Then
fso.createfolder (MyName)
FilePath = MyName
Else
FilePath = MyName
End If
x = 0
'MsgBox MyPages
For i = 0 To MyPages Step PartStep
If i >= MyPages - PartStep Then
s = e + 1
e = MyPages
Else
s = i
e = i + (PartStep - 1)
End If
'MsgBox (i & " | " & s & " | " & e)
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, count:=s
Set rgePages = Selection.Range
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, count:=e
rgePages.End = Selection.Bookmarks("\Page").Range.End
rgePages.Select
Selection.Copy
x = x + 1
Set objDoc = Documents.Add
Selection.GoTo What = wdGoToLine, Which = wdGoToFirst
Selection.PasteAndFormat (wdFormatOriginalFormatting)
DocName = FilePath & "/" & "part" & Format(x, "000") & ".docx"
ActiveDocument.SaveAs2 FileName:=DocName, _
FileFormat:=wdFormatXMLDocument, _
CompatibilityMode:=14
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
Next i
Set objDoc = Documents.Add
DocName = FilePath & "/" & "Merg" & ".docx"
ActiveDocument.SaveAs2 FileName:=DocName, _
FileFormat:=wdFormatXMLDocument, _
CompatibilityMode:=14
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
Windows(1).Activate
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
Dim oData   As New DataObject 'object to use the clipboard
oData.SetText Text:=Empty 'Clear
oData.PutInClipboard 'take in the clipboard to empty it
Application.Quit
End Sub
sub test()
Call Spliter(50)
end sub

OriginalL'auteur amini gazar