| View previous topic :: View next topic |
| Author |
Message |
JohnV Administrator

Joined: 07 Mar 2003 Posts: 8983 Location: Lexinton, Kentucky, USA
|
Posted: Sun Dec 25, 2005 4:04 pm Post subject: Merge multiple copies to 1 file without Mail Merge Wizard |
|
|
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 |
|
 |
JohnV Administrator

Joined: 07 Mar 2003 Posts: 8983 Location: Lexinton, Kentucky, USA
|
Posted: Sun Feb 26, 2006 5:02 pm Post subject: |
|
|
| 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 |
|
 |
Jebbo General User

Joined: 13 Mar 2006 Posts: 36
|
Posted: Mon Mar 13, 2006 6:20 pm Post subject: problem with unselected text |
|
|
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 |
|
 |
JohnV Administrator

Joined: 07 Mar 2003 Posts: 8983 Location: Lexinton, Kentucky, USA
|
Posted: Tue Mar 14, 2006 5:19 am Post subject: |
|
|
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 |
|
 |
Jebbo General User

Joined: 13 Mar 2006 Posts: 36
|
Posted: Tue Mar 14, 2006 6:44 am Post subject: |
|
|
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 |
|
 |
JohnV Administrator

Joined: 07 Mar 2003 Posts: 8983 Location: Lexinton, Kentucky, USA
|
Posted: Tue Mar 14, 2006 7:26 pm Post subject: |
|
|
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 |
|
 |
skribe General User

Joined: 06 Nov 2004 Posts: 8
|
Posted: Sun Sep 10, 2006 6:01 pm Post subject: |
|
|
| 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 |
|
 |
JohnV Administrator

Joined: 07 Mar 2003 Posts: 8983 Location: Lexinton, Kentucky, USA
|
Posted: Mon Sep 11, 2006 1:43 pm Post subject: |
|
|
| I am going to need more information. You should receive a PM. |
|
| Back to top |
|
 |
JohnV Administrator

Joined: 07 Mar 2003 Posts: 8983 Location: Lexinton, Kentucky, USA
|
Posted: Wed Sep 13, 2006 12:23 pm Post subject: |
|
|
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 |
|
 |
|
|
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
|