Splitting a large word doc - by whole page
Thread poster: davehants
Jun 27, 2010

I saw this thread titled:

"Is there an application that can automatically split a large word document into several small ones."

The macro given there by SysfilterMaker is great.

Just one small problem on my file, currently the macro doesn't quite get the splitting page breaks correct - it splits after about 3/4 of the page. Then the bottom portion of that page that it missed is at the top of the next page. And the next page is correspondingly shorter.

The beauty of the macro is that it keeps all the formatting - which no other methods I have tried do.

I just need to get the splitting done at the right page breaks, rather than a few lines before the end of the page.

Any help is appreciated.

Regards,
Dave


 

Michael Grant
Japan
Local time: 21:28
Japanese to English
Modified version of SysFilterMaker's macro Jul 9, 2010

Hi Dave,

I realize this is a bit late, but I was intriqued by your question so I took the liberty of modifying SysfilterMaker's macro to split by pages instead of by percent.

The file "DocSplitter.bas.txt" is here:

http://search.proz.com/connect/files/86605

should you want to take a look. You can either copy/paste the code into a new module, or you can import the file (select all files *.*) in the Word VBE as a new module, 'DocSplitter'.

Please let me know if you use, and how it works (or doesn't?!) for you!

I am happy to receive any feedback or suggestions to make it better!

Michael Grant


 

Michael Grant
Japan
Local time: 21:28
Japanese to English
The modified macro requires a reference to "Microsoft Forms 2.0 Object Library" !!! Jul 9, 2010

Sorry! Forgot to add this!!!:

The macro uses the DataObject object, a part of the Forms library in VBA, to manipulate the Windows clipboard.

In order to make this code work, you must do one of two things.

Have at least one UserForm in your project, or
In the VBA editor, go to Tools, References, and set a reference to the "Microsoft Forms 2.0 Object Library" !!!

Please let me know if this causes too many problems, and I'll remove this dependency.

MLG4035


 

Samuel Murray  Identity Verified
Netherlands
Local time: 14:28
Member (2006)
English to Afrikaans
+ ...
Access? Jul 9, 2010

Michael Grant wrote:
The file "DocSplitter.bas.txt" is here:
http://search.proz.com/connect/files/86605


Error.
You do not appear to be authorized to access this file


icon_smile.gif


 

Michael Grant
Japan
Local time: 21:28
Japanese to English
I was afraid of that! here's the copy/pasted code: Jul 9, 2010

I didn't see any permission settings for files, but I'll double-check... In the meantime, the code is below. This will have to be copy/pasted into an existing VBE module (i.e. you won't be able to File>Import it), let me know how it goes!


Sub doc_splitter()

origdocName = ActiveDocument.Name
origdocPath = ActiveDocument.Path
origdocFullname = ActiveDocument.FullName

Dim oClipBoard As DataObject 'object to use the clipboard
Dim msgDlg, strTitle, DefaultBatch, Batches, strStart, strEnd
Dim pgLastBatch As Boolean
msgDlg = "How many sub-documents do you want?"
strTitle = "WordDoc Splitter - Inspired by W. Polmann (www.ecm-e.de)"
DefaultBatch = "1" ' Default setting.
' Message, title and default display.
Batches = CInt(InputBox(msgDlg, strTitle, DefaultBatch))

pgCount = ActiveDocument.Content.ComputeStatistics(wdStatisticPages)
pctJump = Int(pgCount / Batches) 'Divide total pages by number of subdocuments
pgLastBatch = False
For x = 1 To Batches

ActiveDocument.SaveAs FileName:=origdocPath & Application.PathSeparator & "Part_" & x & "_" & origdocName, _
FileFormat:=wdFormatDocument, AddToRecentFiles:=False, ReadOnlyRecommended:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False

pctJumpEnd = pctJump * x
pctJumpStart = pctJumpEnd - pctJump
If (x = Batches) And (pctJumpEnd < pgCount) Then
pctJumpEnd = pgCount
pgLastBatch = True
End If

If pctJumpStart = 0 Then
pctJumpStart = 1
Else
pctJumpStart = pctJumpStart + 1
End If

'Selection.GoTo What:=wdGoToPercent, Which:=wdGoToNext, Count:=pctJumpStart, Name:=""
Selection.GoTo what:=wdGoToPage, which:=wdGoToNext, Name:=pctJumpStart
strStart = Selection.Start

'Selection.GoTo What:=wdGoToPercent, Which:=wdGoToNext, Count:=pctJumpEnd, Name:=""
Selection.GoTo what:=wdGoToPage, which:=wdGoToNext, Name:=pctJumpEnd

If pgLastBatch = False Then
ActiveDocument.Bookmarks("\Page").Range.Characters.Last.Select
Selection.Collapse Direction:=wdCollapseStart
Else
Selection.GoTo what:=wdGoToLine, which:=wdGoToLast
Selection.MoveRight Unit:=wdCharacter, Count:=1
End If

strEnd = Selection.End

Set Range = ActiveDocument.Range(strStart, strEnd)

Range.Select
Selection.Copy

Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Paste

Selection.GoTo what:=wdGoToPage, which:=wdGoToNext, Name:="1"
ActiveDocument.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader
Selection.ShapeRange.Select
Selection.Delete
ActiveDocument.Save
ActiveDocument.Close

Documents.Open FileName:=origdocFullname, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
Revert:=False, Format:=wdOpenFormatAuto
Next x

ActiveDocument.Close

'Clear the clipboard
Set oClipBoard = New DataObject
oClipBoard.SetText Text:=Empty
oClipBoard.PutInClipboard

reopenOrig = MsgBox("Processing completed successfully!" & vbCrLf & vbCrLf & "Re-open original document?", _
vbYesNo + vbQuestion, "WordDoc Splitter - Inspired by W. Polmann (www.ecm-e.de)")

If reopenOrig = vbYes Then
Documents.Open FileName:=origdocFullname, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
Revert:=False, Format:=wdOpenFormatAuto
Else
Application.Quit
End If
End Sub


 

Michael Grant
Japan
Local time: 21:28
Japanese to English
Modified Doc Splitter macro without Microsoft Forms 2.0 Object Library dependency Jul 12, 2010

Here's the modified Doc Splitter macro without the Microsoft Forms 2.0 Object Library dependency.


Sub doc_splitter()

origdocName = ActiveDocument.Name
origdocPath = ActiveDocument.Path
origdocFullname = ActiveDocument.FullName

Dim msgDlg, strTitle, DefaultBatch, Batches, strStart, strEnd, pgCount, errBatchSize
Dim pgLastBatch As Boolean

DoRetry:
msgDlg = "Number of sub-documents?"
strTitle = "WordDoc Splitter - Inspired by W. Polmann (www.ecm-e.de)"
DefaultBatch = "1" ' Default setting.

Batches = CInt(InputBox(msgDlg, strTitle, DefaultBatch))
pgCount = ActiveDocument.Content.ComputeStatistics(wdStatisticPages)

If Batches > pgCount Then
errBatchSize = MsgBox(The number of sub-documents exceeds the number of pages in the document!" & vbCrLf & _
"This macro works in units of pages, so the number of sub-documents must be LESS THAN OR EQUAL TO the number of pages." & _
vbCrLf & vbCrLf & _
"Click [Retry] to select a smaller number of sub-documents, or [Cancel] to exit the macro.", _
vbRetryCancel + vbCritical, "WordDoc Splitter Error: Number of sub-documents exceeds number of pages!")

If errBatchSize = vbRetry Then 'vbCancel
GoTo DoRetry
Else
Exit Sub
End If
End If

pctJump = Int(pgCount / Batches) 'Divide total pages by number of subdocuments
pgLastBatch = False
For x = 1 To Batches

ActiveDocument.SaveAs FileName:=origdocPath & Application.PathSeparator & "Part_" & x & "_" & origdocName, _
FileFormat:=wdFormatDocument, AddToRecentFiles:=False, ReadOnlyRecommended:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False

pctJumpEnd = pctJump * x
pctJumpStart = pctJumpEnd - pctJump
If (x = Batches) And (pctJumpEnd < pgCount) Then
pctJumpEnd = pgCount
pgLastBatch = True
End If

pctJumpStart = pctJumpStart + 1

Selection.GoTo what:=wdGoToPage, which:=wdGoToNext, Name:=pctJumpStart
strStart = Selection.Start

Selection.GoTo what:=wdGoToPage, which:=wdGoToNext, Name:=pctJumpEnd

If pgLastBatch = False Then
ActiveDocument.Bookmarks("\Page").Range.Characters.Last.Select
Selection.Collapse Direction:=wdCollapseStart
Else
Selection.GoTo what:=wdGoToLine, which:=wdGoToLast
Selection.MoveRight Unit:=wdCharacter, Count:=1
End If

strEnd = Selection.End

Set Range = ActiveDocument.Range(strStart, strEnd)

Range.Select
Selection.Copy

Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Paste

If x > 1 Then
Selection.GoTo what:=wdGoToPage, which:=wdGoToNext, Name:="1"
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^g"
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
With ActiveDocument.PageSetup
.DifferentFirstPageHeaderFooter = False
End With

ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End If

ActiveDocument.Save
ActiveDocument.Close

Documents.Open FileName:=origdocFullname, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
Revert:=False, Format:=wdOpenFormatAuto
Next x

ActiveDocument.Close

reopenOrig = MsgBox("Processing completed successfully!" & vbCrLf & vbCrLf & "Re-open original document?", _
vbYesNo + vbQuestion, "WordDoc Splitter - Inspired by W. Polmann (www.ecm-e.de)")

If reopenOrig = vbYes Then
Documents.Open FileName:=origdocFullname, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
Revert:=False, Format:=wdOpenFormatAuto
Else
Application.Quit
End If
End Sub


[Edited at 2010-07-12 01:48 GMT]

[Edited at 2010-07-12 02:23 GMT]


 


To report site rules violations or get help, contact a site moderator:


You can also contact site staff by submitting a support request »

Splitting a large word doc - by whole page

Advanced search






Déjà Vu X3
Try it, Love it

Find out why Déjà Vu is today the most flexible, customizable and user-friendly tool on the market. See the brand new features in action: *Completely redesigned user interface *Live Preview *Inline spell checking *Inline

More info »
CafeTran Espresso
You've never met a CAT tool this clever!

Translate faster & easier, using a sophisticated CAT tool built by a translator / developer. Accept jobs from clients who use SDL Trados, MemoQ, Wordfast & major CAT tools. Download and start using CafeTran Espresso -- for free

More info »



Forums
  • All of ProZ.com
  • Term search
  • Jobs
  • Forums
  • Multiple search