JohnV
Administrator
Joined: 07 Mar 2003
Posts: 8979
Location: Lexinton, Kentucky, USA
|
 Posted: Wed Feb 25, 2004 2:40 pm Post subject: Copy object to multipe pages - continued |
 |
|
This is my latest version of a macro that will copy a selected object to a range of pages in a Writer doc. The purpose of this macro is to allow a user to put a frame or graphic on a lot of pages without having to copy it numerous times. (Company logo – line numbering outside the margins for legal pleadings – a “footer” on the side, etc.)
I have also used a new FileSaver subroutine to ensure that no one using this macro will ever lose his original file if things go awry (how would you like to have to manually delete an inadvertently selected object from a 100 page file?). If you write macros that have potentially harmful effects on your own or others' files please feel free to use it (if anyone sees a potential problem with this routine please let me know).
This macro seems to work quite well with objects located outside the margins which must therefore be anchored to the page. It also works well with objects located within the margins IF anchored to the page. It may skip a page if the object is large due to the fact that such objects normally will require existing text to wrap around the new object which is time consuming and occasionally the program will literally get ahead of itself. A commented “Wait 400” instruction can be uncommented if you run into this problem.
Objects within the margins that are anchored to paragraphs will be copied but the results may be disappointing because the object must attach itself to the beginning of the 1st paragraph that actually begins on the page so the location of the object may not be where you want it.
As with my last version, the selected object can be located anywhere in the doc, you may copy forward or backwards, specify the last page for the copies and do all or every other page.
| Code: | 'Copy a SELECTED object to range of pages. Works best with objects anchored to the page.
Sub CopyObjectToPages '2-19-04
On Error goto ErrorH 'Go to error handler if needed
FileSaver(false) : CR = Chr(13) 'File protect and save routine. CR = carriage return.
oDoc = thisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
'Copy the object to clipboard
dispatcher.executeDispatch(oDoc, ".uno:Copy", "", 0, Array())
'Get the number of pages
oVC = oDoc.Controller.getViewCursor():iSelectionPage = oVC.getPage()
oVC.jumpToLastPage(): iLastPage = oVC.getPage()
sStop = Cstr(iLastPage): sStopBak = sStop 'Default stop copy page as String
oVC.jumpToPage(iSelectionPage)
'Get user input. Specifies the last copy page & whether every other page.
CopyWhere: 'Return here if impossible page designated.
a$ = "Default copy is to all pages from the page where you made your selection to the last "
b$ = "page. You can enter a different last page below, either forward or backward. Specify "
c$ = "every other page by appending an 's' to the page number. (Example: " & sStop & "s)"
sTx = a$ & b$ & c$ : Answer = GetAns(sTx,6,"Copy Where?",sStop): GoSub Quit 'Quit?
sStop = Answer : Trim(sStop): iStep = 1 'Remove spaces. iStep = For/Next loop step rate
'Doing every other page? If so, adjust stepping and remove 's'
If (InStr(sStop,"s") > 0) then
iStep = 2: sStop = Left(sStop,Len(sStop)-1)
EndIf
iStop = Cint(sStop) 'Stop copy page as Integer
'Going backwards? If so adjust stepping.
If (iStop < iSelectionPage) then iStep = iStep * -1
iStart = iSelectionPage + iStep 'Set the 1st copy page
'Check for impossible page
If (iStart < 1 or iStart > iLastPage or iStop < 1 or iStop > iLastPage) then
a$ = "Can not copy to a page that does not exist." & CR & "A specified page is less than"
b$ = " 1 or beyond your last page which is " & iLastPage & "." & CR & "Start copy page = "
c$ = iStart & ", Last copy page = " & iStop & CR & "Please try again."
sTx = a$ & b$ & c$ : GetAns(sTx,16,"Bad page selection.","")
sStop = sStopBak: GoTo CopyWhere 'Return to page selection do to impossible page
EndIf
'Set up & get final user input.
If (Abs(iStep) = 2) then
If (iStart mod 2) = 0 then
sOddOrEven = "even"
Else sOddOrEven = "odd"
EndIf
y$ = CR & "Copying to " & sOddOrEven & " numbered pages only." & CR
EndIf
a$ = "Your selected object, if any, is located on page " & iSelectionPage & "." & CR
b$ = "If you forgot to select an object to copy then Cancel!" & CR & "Copying will start on "
c$ = "page " & iStart & "." & CR & "Copying will not go beyond page " & iStop & "." & CR & y$
d$ = CR & "Just in case, a backup copy of your current document will be saved. "
sTx = a$ & b$ & c$ & d$
Answer = GetAns(sTx,1,"Ready to copy!"): GoSub Quit
PasteObj: 'Error handler returns here if 1st try fails(iCnt>1) or on cont. after file error.
'iterate through the pages and paste the object
For x = iStart to iStop Step iStep
oVC.jumpToPage(x)
Recover: 'Error handler returns here for 1st try (iCnt=1)
dispatcher.executeDispatch(oDoc, ".uno:Paste", "", 0, Array())
'Wait 400 'USE THIS PAUSE FOR LARGE FRAMES INSIDE THE MARGINS
Next x
Wait 1000 'Let the thread complete.
oVC.jumpToLastPage(): iCurLast = oVC.getPage() 'Check for added pages
If (iCurLast > iLastPage and x <= iCurLast) then
a$ = "Previous last page = " & iLastPage & CR & "Current last page = " & iCurLast & CR
b$ = "Due to text wrapping around the copied object new pages have been added to the "
c$ = "document." & CR & "Continue copying to the new pages?"
sTx = a$ & b$ & c$ : Answer = GetAns(sTx,33,"New Pages Added!")
Else 'No new pages so quit. This is the normal exit point.
oVC.jumpToPage(iSelectionPage) : FileSaver(true) : On Error Goto 0: End
EndIF
If (iAns = 2) then 'Don't copy to new pages so quit. A normal exit point.
oVC.jumpToPage(iSelectionPage) : FileSaver(true) : On Error Goto 0: End
Else 'Copy to new pages
iStart = x: iStop = iCurLast: iLastPage = iCurLast: GoTo PasteObj
EndIf
'////////////////////////////////GOSUB QUIT\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Quit:
If (Answer = "" or Answer = 2) then On Error GoTo 0: End 'User wants to quit.
Return
'//////////////////////////////ERROR HANDLER\\\\\\\\\\\\\\\\\\\\\\\\\\\
ErrorH:
iCnt = iCnt + 1
If(oVC.getPage() = 1) then 'My best check for file save error. Isn't always 12.
iAns = Msgbox("Unable to backup file. Continue without backup?",1,"File Save Error")
If (iAns = 2) then
On Error Goto 0: Exit Sub
Else iCnt = 0: Resume Next
EndIf
EndIf
Select Case Err
case 1 'Most likely a Paste error.
If (iCnt = 1) then 'First try a silent recovery by moving cursor
oVC.jumpToEndOfPage(): GoTo Recover
Else 'Recovery failed, alert user & go to next page
a$ = "Unable to copy object to page " & oVC.getPage() & "."
b$ = CR & "Continuing to next page." : MsgBox a$ & b$
iCnt = 0: Resume Next
EndIf
case else ' No other consistent error numbers found yet.
Msgbox ("An unexpected error occurred. Exiting!",0,"OOPS!")
End Select
On Error GoTo 0
End Sub
Function GetAns(sTx$,Optional iType%,Optional sTle$,Optional sDef$)
If (iType = 6) then '6 calls for inputbox because it's not a type used for message boxes
GetAns = InputBox (sTx,sTle,sDef)
Else
GetAns = Msgbox (sTx,iType,sTle)
Endif
End Function
Sub FileSaver(Finish as Boolean) 'Set the application extension for new file:
Static WasPath : Static SavePath : AppExt = ".sxw" '<=======================
GlobalScope.BasicLibraries.LoadLibrary("Tools")
If (Finish) then goto Final
WasPath = convertFromURL(thiscomponent.URL) : WasCopy = WasPath
If (WasPath = "") then
WorkURL = GetPathSettings("Work") : WorkPath = convertFromURL(WorkURL) + "\"
Waspath = InputBox("Enter a file name or full path","UNSAVED FILE",WorkPath)
If (Instr(WasPath,".") = 0) then WasPath = WasPath + AppExt
If (Instr(convertToURL(WasPath),"/") = 0) then WasPath = WorkPath + WasPath
EndIf
While Mid(convertToURL(WasPath),Len(convertToURL(WasPath))-NAMElon,1) <> "/"
NAMElon = NAMElon + 1
Wend
Do
If Mid(WasPath,Len(WasPath)-NAMEcnt,1) = "." then
NAMEext = Right(WasPath,NAMEcnt+1) : NAMEloe = Len(NAMEext) : Exit Do
EndIf
NAMEcnt = NAMEcnt + 1
Loop While NAMEcnt < NAMElon
SavePath = WasPath : If (Right(SavePath,NAMEloe) <> AppExt) then SavePath = SavePath + AppExt
Do
WasPath = Left(WasPath,Len(WasPath)-NAMEloe) + ".B4" + NAMEext
Loop While FileExists(WasPath)
If (FileExists(SavePath) and SavePath <> WasCopy) then
iAns = MsgBox("OK to OVERWRITE: " & Chr(13) & SavePath & " ?",36,"EXISTING FILE")
If (iAns <> 6) then End
EndIf
thisComponent.StoreToURL(convertToURL(WasPath),Array())
Exit Sub
Final: thisComponent.StoreAsURL(convertToURL(SavePath), Array())
a$ = "Your original file was saved as:" & Chr(13) & WasPath & Chr(13)
b$ = "Your new file was saved as:" & chr(13) & SavePath : MsgBox a$ & b$
End Sub |
|
|
