PatriciaD
09-27-2010, 08:48 AM
I am SO sorry to be posting. I have seen that there are other posts similar to mine already on here, but I just don't understand the VBA code well enough to adapt it quickly to my situation. My question is similar to Gentle and Philkp, but with differences, obviously.
I am designing recipe cards. some of my documents are over 10 pages long, with each page being a different recipe. (some recipes are 2 pages long). I want to split the document so that each recipe is its own document and that the filename is the name of the recipe, which is the first line of the document. It is NOT a header, just a bold/larger font size than the other parts of the document.
I liked Graham Skan's macro, but it is supposed to be for single pages only. On rare occasions, mine will be two pages. Also, his numbers each new document according to the original page number. I am putting his macro below with what I believe I need to change in green highlight.
I do have hard page breaks for the separation between recipes. As I said I just want the first line of the new document to be the file name. I have attached a .docx file as an example.
Thank you in advance for your help!
Patricia
Sub SplitIntoPages()
Dim docMultiple As Document
Dim docSingle As Document
Dim rngPage As Range
Dim iCurrentPage As Integer
Dim iPageCount As Integer
Dim strNewFileName As String
Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _
flicker a bit.
Set docMultiple = ActiveDocument 'Work on the active document _
(the one currently containing the Selection)
Set rngPage = docMultiple.Range 'instantiate the range object
iCurrentPage = 1
'get the document's page count
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page)
Else
'Find the beginning of the next page
'Must use the Selection object. The Range.Goto method will not work on a page
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
'Set the end of the range to the point between the pages
rngPage.End = Selection.Start
End If
rngPage.Copy 'copy the page into the Windows clipboard
Set docSingle = Documents.Add 'create a new document
docSingle.Range.Paste 'paste the clipboard contents to the new document
'remove any manual page break to prevent a second blank
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
'build a new sequentially-numbered file name based on the original multi-paged file name and path
strNewFileName = Replace(docMultiple.FullName, ".docx", "_" & Right$("000" & iCurrentPage, 4) & ".docx")
docSingle.SaveAs strNewFileName 'save the new single-paged document
iCurrentPage = iCurrentPage + 1 'move to the next page
docSingle.Close 'close the new document
rngPage.Collapse wdCollapseEnd 'go to the next page
Loop 'go to the top of the do loop
Application.ScreenUpdating = True 'restore the screen updating
'Destroy the objects.
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub
I am designing recipe cards. some of my documents are over 10 pages long, with each page being a different recipe. (some recipes are 2 pages long). I want to split the document so that each recipe is its own document and that the filename is the name of the recipe, which is the first line of the document. It is NOT a header, just a bold/larger font size than the other parts of the document.
I liked Graham Skan's macro, but it is supposed to be for single pages only. On rare occasions, mine will be two pages. Also, his numbers each new document according to the original page number. I am putting his macro below with what I believe I need to change in green highlight.
I do have hard page breaks for the separation between recipes. As I said I just want the first line of the new document to be the file name. I have attached a .docx file as an example.
Thank you in advance for your help!
Patricia
Sub SplitIntoPages()
Dim docMultiple As Document
Dim docSingle As Document
Dim rngPage As Range
Dim iCurrentPage As Integer
Dim iPageCount As Integer
Dim strNewFileName As String
Application.ScreenUpdating = False 'Makes the code run faster and reduces screen _
flicker a bit.
Set docMultiple = ActiveDocument 'Work on the active document _
(the one currently containing the Selection)
Set rngPage = docMultiple.Range 'instantiate the range object
iCurrentPage = 1
'get the document's page count
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
Do Until iCurrentPage > iPageCount
If iCurrentPage = iPageCount Then
rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page)
Else
'Find the beginning of the next page
'Must use the Selection object. The Range.Goto method will not work on a page
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1
'Set the end of the range to the point between the pages
rngPage.End = Selection.Start
End If
rngPage.Copy 'copy the page into the Windows clipboard
Set docSingle = Documents.Add 'create a new document
docSingle.Range.Paste 'paste the clipboard contents to the new document
'remove any manual page break to prevent a second blank
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""
'build a new sequentially-numbered file name based on the original multi-paged file name and path
strNewFileName = Replace(docMultiple.FullName, ".docx", "_" & Right$("000" & iCurrentPage, 4) & ".docx")
docSingle.SaveAs strNewFileName 'save the new single-paged document
iCurrentPage = iCurrentPage + 1 'move to the next page
docSingle.Close 'close the new document
rngPage.Collapse wdCollapseEnd 'go to the next page
Loop 'go to the top of the do loop
Application.ScreenUpdating = True 'restore the screen updating
'Destroy the objects.
Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing
End Sub