OpenOffice.org Forum at OOoForum.orgThe OpenOffice.org Forum
 
 [Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register
 [Profile]   [Log in to check your private messages]   [Log in

Merge multiple copies to 1 file without Mail Merge Wizard

 
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets
View previous topic :: View next topic  
Author Message
JohnV
Administrator
Administrator


Joined: 07 Mar 2003
Posts: 9183
Location: Lexinton, Kentucky, USA

PostPosted: Sun Dec 25, 2005 4:04 pm    Post subject: Merge multiple copies to 1 file without Mail Merge Wizard Reply with quote

EDITED 2/21/06 to change to macro version 2 which will automatically insert any needed Next Record fields. The macro does not require database fields from only one data source.
EDITED 3/14/06 to change to version 2.1 to correct bug mentioned in posts below.
EDITED 9/13/06 to change to version 2.2 to correct bug mentioned by skribe in posts below.
EDIT 11/21/06 to change to version 2.3 to avoid error if run on non Writer doc and upgrade identification of label type doc.

This macro is basically a sophisticated copy & paste that was inspired by forum member gruslo, then an OOo1.1.x user, and his method of getting around that version's inability of merge multiple document copies to a single file.

The macro will allow you to do several different, but related, things.
1) Copy selected text N times just below itself in a Writer document. This is of value when designing your own reports and you need to format the fields or text.
2) Merge multiple label or business card pages into a single file.
3) Double the size of any document containing an odd number of pages that OOo2 users want to merge to a single file with the Mail Merge Wizard so that blank pages are not inserted in the file.
4) Mail merge multiple copies of a document to a single file without using OOo2's Mail Merge Wizard. It is not quite as capable as the Wizard but certainly faster. Below are the rules you should try to follow for this one.

a) Page numbers, if used, must be manually entered. Remember this is a copy & paste operation so they would be consecutive if the page number was in a field.
b) A frame should not be anchored to a page or the last paragraph of the document.
c) A table must have one paragraph above it and one below.
d) Use no more than 2 page styles and those only if they are like First Page (which, by default, is followed by the Default page style) and Default (which, by default, is followed by itself). You may actually be able to get away with something like First followed by Second followed by Default but the macro only sets the style of the first page and the actual styles control what happens thereafter.
e) If using more than one page style keep their sizes the same or very close to it. You may get away with violating this one but it all depends on the particular document.

The macro has not been heavily tested and certainly not with very complex documents.
Code:
Sub MakeCopies 'Version 2.3 11/21/06
On Error goto ErrorHandler
Dim MMerge as Boolean : Dim hasDBfields as Boolean
oDoc = thisComponent
If Not oDoc.SupportsService("com.sun.star.text.TextDocument") then
 MsgBox "This macro only works with Writer files." : End
EndIf
document = ThisComponent.CurrentController.Frame 'Initialize dispatcher
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
oVC = oDoc.CurrentController.getViewCursor 'If a frame is selected a trapped
'error will occur below.
oStart = oDoc.Text.createTexTCursor
oEnd = oDoc.Text.createTextCursor
REM Gather info.
oDocSettings = ThisComponent.createInstance("com.sun.star.text.DocumentSettings")
If oDocSettings.isLabelDocument then LD = true
SelectLen = Len(oVC.String) 'Possible error #1 here.
If SelectLen > 0 then
 DocType = "Selection"
 a$ = "You have selected text. It will be copied just below itself."
 a$ = a$ & " You can select one or more empty paragraphs below text to "
 a$ = a$ & "provide spacing. Is this what you want?"
 iAns = MsgBox(a$,3,"Text is selected.")
 If iAns = 2 then Exit Sub 'User clicked Cancel.
EndIf
If LD  then
 DocType = "Labels"
 a$ = "This appears to be a "
 a$ = a$ & "label or business card 'template'. Is it?"
 iAns = MsgBox(a$,3,"Probable label or business card template.")
 If iAns = 2 then Exit Sub
EndIf
If iAns <> 6 then 'Answer isn't "yes".
 DocType = "Letter"
 a$ = "Is this a form letter type document? If so, each copy will start "
 a$ = a$ & "on a new page. Is this what you want?"
 iAns = MsgBox(a$,3,"Is this a form letter?")
 If iAns = 2 then Exit Sub
EndIf
If iAns <> 6 then 'No file type selected.
 a$ = "1 = Selected text or, if none, entire document"
 a$ = a$ & " will be copied just below itself. " & Chr(10)
 a$ = a$ & "2 = Labels or business cards, or"  & Chr(10)
 a$ = a$ & "3 = Other document with copies starting on new pages."
 b$ = "Take your best shot.  Select, by number, a type that "
 b$ = b$ & "sounds close to what you want."
 sAns = InputBox(a$,b$)
 If sAns = "" then Exit Sub
 If Instr("123",sAns) = 0 then Exit Sub
 Select Case Int(sAns)
  Case 1 : DocType = "Selection"
  Case 2 : DocType = "Labels"
  Case 3 : DocType = "Letter"
  Case Else : Print "Macro Logic Error!" : Exit Sub
 End Select
EndIf
REM Enough info collected to set start & end cursors
'so all DocTypes can use them for 1st copy.
If DocType = "Selection" then
  oVC.BreakType = 0
  If oVC.isCollapsed then
    oStart.gotoStart(false) : oEnd.gotoEnd(False)
   Else
    oStart.gotoRange(oVC.Start,false)
    oEnd.gotoRange(oVC.End,false)
  EndIF
  hasDBfields = CheckNextRecord(oDoc,oVC,document,dispatcher,true)
  If hasDBfields then
   f$ = "Does your selection contain database table fields?"
   If MsgBox(f$,4,"Database fields?") = 6 then SelectionFields = true
  EndIf
  If SelectionFields then
   CheckNextRecord(oDoc,oVC,document,dispatcher,false)
   oVC.gotoRange(oStart,true)
  EndIf
 Else oStart.gotoStart(false) : oEnd.gotoEnd(False)
  MMerge = AreWeUsingMailMerge()
EndIf
'Set letters to start on new page.
If DocType = "Letter" then
 If NOT MMerge then
   CheckNextRecord(oDoc,oVC,document,dispatcher,false)
 EndIf   
 oVC.gotoStart(false) : PgStyl = oVC.PageStyleName
EndIf
If DocType <> "Selection" then
 oVC.gotoRange(oEnd,false) : pages = oVC.getPage
 If MMerge AND pages Mod 2 = 0 then
  b$ = "There are already an even number of pages (" & pages & ") so "
  b$ = b$ & "you can go directly to Mail Merge. The macro will end."
  MsgBox(b$,,"Ready for Mail Merge." : Exit Sub
  iAns = Msgbox(b$,4,"Continue?")
 EndIf
EndIf
If MMerge then
  copies = 2
 Else copies = GetCopiesNeeded(DocType,FrameCnt)
EndIf
oVC.gotoRange(oStart,false) : oVC.gotoRange(oEnd,true)'Get all.
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())'Copy selected to clipboard.
oEnd.goLeft(1,false)
targetPages = copies * pages : copiesMade = 1
Do
 If copiesMade * 2 > copies then Exit Do
 oVC.collapseToEnd : thePage = oVC.getPage
 If DocType = "Letter" then
   dispatcher.executeDispatch(document, ".uno:InsertPagebreak", "", 0, Array())
  Else
   dispatcher.executeDispatch(document, ".uno:InsertPara", "", 0, Array())
 EndIf
 dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
 oVC.gotoRange(oStart,true) 'Copy all.
 dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
 copiesMade = copiesMade * 2
Loop
currentPages = oVC.getPage
If DocType = "Selection" then
  If copiesMade < copies then
   oMark = oDoc.Text.CreateTextCursorByRange(oVC.End) : oEnd.goRight(1,false)
   oVC.gotoRange(oStart,false) : oVC.gotoRange(oEnd,true) 'Get original.
   dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
   oVC.gotoRange(oMark,False)
   Do While copiesMade < copies
    dispatcher.executeDispatch(document, ".uno:InsertPara", "", 0, Array())
    dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
    copiesMade = copiesMade + 1   
   Loop
  EndIf
 ElseIf currentPages < targetPages then
  needPages = targetPages - currentPages
  oVC.jumpToPage(currentPages - needPages + 1)
  oVC.gotoEnd(true)
  dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
  oVC.collapseToEnd
  dispatcher.executeDispatch(document, ".uno:InsertPara", "", 0, Array())
  dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
  currentPages = oVC.getPage
  For x = 1+pages to currentpages step pages
   oVC.jumpToPage(x)
   oVC.setPropertyValue("PageDescName", PgStyl)
  Next
  oVC.gotoStart(false)   
EndIf
If MMerge then
  oVC.JumpToPage(pages) : oVC.JumpToEndOfPage(false)
  CheckNextRecord(oDoc,oVC,document,dispatcher,false,MMerge)
  MsgBox("Documents or labels ready for the Mail Merge Wizard.",,"Finished.")
 Else
  a$ = "If using database table fields, to complete the merger press F4, find and "
  a$ = a$ & "click your database table, select records with the gray buttons to their"
  a$ = a$ & " left (upper left for all) and click the Data to Fields icon."
  MsgBox(a$,,copies & " copies made.")
  oVC.gotoStart(false)
EndIf
END
ErrorHandler:
If Err = 1 then
  dispatcher.executeDispatch(document, ".uno:Escape", "", 0, Array())'This causes
  'the view cursor to unselect the frame/graphic it had selected.
  SelectLen = 0
  Resume Next
 Else Print "Unexpected error #" & Err & " in line #" & Erl & Chr(13) & Error$
EndIf
End Sub

Function AreWeUsingMailMerge()
 a$ = "If using OOo version 2 and you intend to use the Mail Merge Wizard to "
 a$ = a$ & "complete this task then click 'Yes'. Your file size will "
 a$ = a$ & "simply be doubled. Click 'No' to avoid the Mail Merge Wizard."
 iAns = MsgBox(a$,4,"Using Mail Merge Wizard?")
 If iAns = 6 then
   AreWeUsingMailMerge = true
  Else AreWeUsingMailMerge = false
 EndIf
End Function

Function GetCopiesNeeded(DocType,FrameCnt)
If DocType <> "Labels" then
  a$ = "Enter desired number of total copies (including original) - "
  a$ = a$ & "usually the number of records in your database table."
 Else  a$ = "Entry the number of records in your database table and "
  a$ = a$ & "the number of copies will be computed based on the"
  a$ = a$ & " number of labels per sheet. You will have an "
  a$ = a$ & "opportunity to override the calculation of copies."
EndIf     
b$ = "Get number of copies." : GoSub GetKopies
If DocType = "Labels" then
 C = copies : copies = copies/FrameCnt
 If copies <> Int(copies) then
  copies = Int(copies) + 1 : CC = " + 1 for the remainder"
 EndIf
 a$ = "Calculated copies = records/labels per page ("
 a$ = a$  & C & "/" & FrameCnt & ")" & CC & "." & Chr(13)   
 a$ = a$ & "If you want a different number of total copies "
 a$ = a$ & "(including the original) then enter it below."
 b$ = "Confirm or change desired copies."
 GoSub GetKopies
EndIf
Exit Function
GetKopies:
copies = InputBox(a$,b$,copies)
If copies = "" then End
If Not isNumeric(copies) then Goto GetKopies
copies = Int(copies)
GetCopiesNeeded = copies
Return
End Function

Function CheckNextRecord(oDoc,oVC,document,dispatcher,ret as Boolean,Optional MMerge)
Dim Names(0,1)
Dim NameExists as Boolean : Dim hasNR as Boolean   
tfm = oDoc.getTextFieldMasters()
en = tfm.getElementNames()
For i = 0 to uBound(en)
 sName = en(i)
 If Instr(sName,"Database") > 0 then
  If ret then CheckNextRecord = true : Exit Function
  Parts = Split(sName,".")
  DB = Parts(6) : hasDBfields = true
  Table = Parts(7)
  Upper = uBound(Names())
  For x = 0 to Upper
   If Names(x,0) = DB AND Names(x,1) = Table then
    NameExists = true : Exit For
   EndIf
  Next
  If Not NameExists then
   Redim Preserve Names(Upper + 1,1)
   Names(Upper,0) = DB : Names(Upper,1) = Table
  EndIf
 EndIf
Next i
If hasDBfields then
 tf = oDoc.getTextFields
 oEnum = tf.createEnumeration
 Do While oEnum.hasMoreElements
  thisEl = oEnum.nextElement
  If Instr(thisEl.getPresentation(true),"Next record") > 0 then
   hasNR = true : Exit Do
  EndIf
 Loop
EndIf
REM Insert next Record field if needed.
If hasDbfields And Not hasNR then
 If oVC.isCollapsed then
   If NOT MMerge then oVC.gotoEnd(false)
  Else oVC.collapseToEnd
 EndIf
 Dim args1(6) as new com.sun.star.beans.PropertyValue
 For x = 0 to uBound(Names())-1
  args1(0).Name = "Type" : args1(0).Value = 24
  args1(1).Name = "DBName" : args1(1).Value = Names(x,0)  'Database name.
  args1(2).Name = "Command" : args1(2).Value = Names(x,1) 'Table name.
  args1(3).Name = "ColumnName" : args1(3).Value = "TRUE"
  args1(4).Name = "CommandType" : args1(4).Value = 0
  args1(5).Name = "Content" : args1(5).Value = ""
  args1(6).Name = "Format" : args1(6).Value = 0
  dispatcher.executeDispatch(document, ".uno:InsertDBField", "", 0, args1())
 Next
EndIf
End Function


Last edited by JohnV on Sat Jan 13, 2007 10:32 am; edited 5 times in total
Back to top
View user's profile Send private message
JohnV
Administrator
Administrator


Joined: 07 Mar 2003
Posts: 9183
Location: Lexinton, Kentucky, USA

PostPosted: Sun Feb 26, 2006 5:02 pm    Post subject: Reply with quote

I don't know if anyone is using this macro but if so please note that I have updated the original post with version 2 that eliminates the necessity of the user having to insert the Next Record field when choosing not to use the Mail Merge Wizard.
Back to top
View user's profile Send private message
Jebbo
General User
General User


Joined: 13 Mar 2006
Posts: 36

PostPosted: Mon Mar 13, 2006 6:20 pm    Post subject: problem with unselected text Reply with quote

John,

Tried this out and it works nicely. I did see one odd behavior, which I'll try to summarize accurately (I haven't tried to debug the code for it).

New Writer doc with original text like:

Code:
Test Document2
item= <item>
cost= <cost>
End Document


I highlighted this section and ran the macro, did the update from the Data Source, all good. Then I saved and closed the document, closed all open OO.o docs.

Next I opened a new Writer doc and put in the following

Code:
Test Document3
item= <item>
cost= <cost>
End Document


And this time I did not highlight anything (on the expectation that the macro would do copy everything, since that's what I wanted to happen). Ran the macro, and lo and behold instead of looking like this:

Code:
Test Document3
item= <item>
cost= <cost>
End Document
(next record thing would be here)

Test Document3
item= <item>
cost= <cost>
End Document
(next record thing would be here)

Test Document3
item= <item>
cost= <cost>
End Document
(next record thing would be here)


instead it was like this

Code:
Test Document3
item= <item>
cost= <cost>
End Document
(next record thing would be here)
Test Document2
item= <item>
cost= <cost>
End Document
(next record thing would be here)

Test Document2
item= <item>
cost= <cost>
End Document
(next record thing would be here)


Note the Document2 rather than Document3... and I had closed all docs. So I deleted everything but the original Document3 entry, highlighted it and re-ran the macro (like original run) and it was fine.

So it appears to me that the code, when nothing is highlighted, might make use of previously highlighted/copied text.

Just FYI. Nice code, it's been a huge help. Also FYI I did not use the mail merge wizard or separate pages (form letter?) options.

Jeff
Back to top
View user's profile Send private message
JohnV
Administrator
Administrator


Joined: 07 Mar 2003
Posts: 9183
Location: Lexinton, Kentucky, USA

PostPosted: Tue Mar 14, 2006 5:19 am    Post subject: Reply with quote

Thanks for your report. I'll have a look at this and get back.

EDIT - Thinking about this I believe I know what the problem is without reviewing the code - an assumption on my part about how users would use the option you are using (copy a section of document x times after itself). You can see that I just used the word "section" which would mean something was selected and you want to do it with the whole text. Sounds like an easy fix to me and I'll do so.
Back to top
View user's profile Send private message
Jebbo
General User
General User


Joined: 13 Mar 2006
Posts: 36

PostPosted: Tue Mar 14, 2006 6:44 am    Post subject: Reply with quote

Yes, that sounds like the issue. Given that it isn't hard to highlight everything, I don't necessarily think the way it works now is a problem. It was the prompt:

a$ = a$ & Chr(13) & "1 = Selected text or, if none, entire document"
a$ = a$ & " will be copied just below itself. "

that led me to try out the "none, entire document" option and stumble on the unexpected behavior.

Thanks again.
Back to top
View user's profile Send private message
JohnV
Administrator
Administrator


Joined: 07 Mar 2003
Posts: 9183
Location: Lexinton, Kentucky, USA

PostPosted: Tue Mar 14, 2006 7:26 pm    Post subject: Reply with quote

Well I got the prompt right but just failed to follow up in the code. I have corrected the code in the original post.

Let me know if you run into any other problems.
Back to top
View user's profile Send private message
skribe
General User
General User


Joined: 06 Nov 2004
Posts: 8

PostPosted: Sun Sep 10, 2006 6:01 pm    Post subject: Reply with quote

I'm flummoxed where macros are concerned. How am I supposed to use this? I've copied it in the required area (tools->macros->etc) and it runs fine. However it seems to allow me to use the mail merge wizard with it. The problem is that it just seems to make a copy of each of the odd numbered pages so I end up with double the records. Is that correct?
Back to top
View user's profile Send private message
JohnV
Administrator
Administrator


Joined: 07 Mar 2003
Posts: 9183
Location: Lexinton, Kentucky, USA

PostPosted: Mon Sep 11, 2006 1:43 pm    Post subject: Reply with quote

I am going to need more information. You should receive a PM.
Back to top
View user's profile Send private message
JohnV
Administrator
Administrator


Joined: 07 Mar 2003
Posts: 9183
Location: Lexinton, Kentucky, USA

PostPosted: Wed Sep 13, 2006 12:23 pm    Post subject: Reply with quote

skribe,

Thank you for the bug report and the additional information provided. I have edited the 1st message in this thread to provide a corrected version of the macro so please try it.

I note that if I run the Mail Merge Wizard on a document that contains a Next Record field* that it appears to work correctly the 1st time but if I run the Wizard again, at least on the same document, that it creates a blank document. Closing just OOo but not the Quickstatrter fixes this.

*The macro now inserts a Next Record field at the end of your original document's last page.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets All times are GMT - 8 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group