#1
|
|||
|
|||
Split a Word document in "n" pages
Hi, I would like any help, or some code, the idea is split word documents in "n" pages, respecting headers and footers also section break, each document has 2 break section and "n" break pages, I was trying to put a Wilcard "FIN" at the end of each document, but I have some trouble with my excel document where I send the "name word documents" massively.
Thanks in advance, Code:
Option Explicit Sub Word_Individuales() Dim mArchivo As Variant, fdocument As Document Dim miExcel As String, target As Variant, obSQL As String Dim cnn As Object, dataread As Object, filas As Long Dim i As Long, iname As Variant, midoc As Document Dim miArchivo As String, campo As String, miCarpeta As Variant Dim paginasDocumento As Integer Dim totalPaginas As Integer Dim pagActual As Integer Dim nombreDocs As String Dim lngStart As Long Dim lngEnd As Long Dim lngDocNum As Long Dim docOld As Document Dim docNew As Document Set fdocument = ThisDocument Set mArchivo = Application.FileDialog(msoFileDialogOpen) If mArchivo.Show = 0 Then Exit Sub miExcel = mArchivo.SelectedItems(1) Set miCarpeta = Application.FileDialog(msoFileDialogFolderPicker) If miCarpeta.Show = 0 Then Exit Sub miCarpeta = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\" Set target = Documents.Add obSQL = "SELECT [BBDD$].[INFORME] FROM [BBDD$]" Set cnn = New ADODB.Connection With cnn .Provider = "Microsoft.ACE.OLEDB.12.0" .Connectionstring = "DATA SOURCE=" & miExcel .Properties("Extended Properties") = "Excel 8.0" .Open End With Set dataread = New ADODB.Recordset With dataread .Source = obSQL .ActiveConnection = cnn .CursorLocation = adUseClient .CursorType = adOpenForwardOnly .LockType = adLockReadOnly .Open End With dataread.MoveFirst filas = dataread.RecordCount Selection.InsertAfter dataread.Fields(0) Do Until dataread.EOF dataread.MoveNext If dataread.EOF = "Verdadero" Then Exit Do campo = Replace(dataread.Fields(0), "-", " ") Selection.InsertAfter Chr(11) & campo Loop Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _ numcolumns:=1, Numrows:=filas, AutoFitBehavior:=wdAutoFitFixed Set midoc = ActiveDocument pagActual = 1 Do Set iname = midoc.Tables(1).Cell(i, 1).Range miArchivo = Mid(Replace(miCarpeta & iname.Text, Chr(13), ""), 1, _ Len(Replace(miCarpeta & iname.Text, Chr(13), "")) - 1) lngStart = 1 Set docOld = fdocument ' ActiveWindow.Selection.HomeKey Unit:=wdStory With Selection.Find 'With docOld '.ClearFormatting .Text = "Hacer de conocimiento*^13" .MatchWildcards = True .Wrap = wdFindStop If i = midoc.Tables(1).Rows.Count Then Exit Sub Selection.Collapse Direction:=wdCollapseEnd lngEnd = Selection.End ' Copy the "section" docOld.Range(lngStart, lngEnd).Copy 'Create a new document to paste text from clipboard. Set docNew = Documents.Add Selection.Paste ' Save the new document lngDocNum = lngDocNum + 1 docNew.SaveAs FileName:="Section_" & lngDocNum & ".docx", _ FileFormat:=wdFormatXMLDocument docNew.Close ' set new start lngStart = lngEnd + 1 End With pagActual = pagActual + paginasDocumento i = i + 1 Loop Until i = midoc.Tables(1).Rows.Count ActiveDocument.Close SaveChanges:=False End Sub |
#2
|
||||
|
||||
See Split Merged Output to Separate Documents in the Mailmerge Tips and Tricks thread at:
https://www.msofficeforums.com/mail-...ps-tricks.html If this is for a mailmerge, a better approach is found in the Send Mailmerge Output to Individual Files topic in the same thread.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
I clicked "this document" in VBA thinking it was a menu button, it said "saving", how can I reverse | messgchr | Word VBA | 2 | 07-20-2020 06:52 PM |
The "group or ungroup text range" control in the developer tab breaks my document up into many pages | damiansiniakowicz | Word | 8 | 05-10-2018 12:30 PM |
Disabling "jumping" pages when scrolling down thru a document | ravl13 | Word | 0 | 04-12-2017 01:34 PM |
The "body of text" for all odd-numbered pages are all "vertically-centered-aligned". | keepcalmandreadabook | Word | 5 | 03-27-2017 04:08 PM |
Keyboard toggle for switching between two split "screens" in Word 2010 | BAEngelTranslations | Word | 4 | 10-26-2015 04:44 AM |