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

move/copy sheet from one calc document to another SOLVED

 
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Macros and API
View previous topic :: View next topic  
Author Message
bobomonkey_sr
General User
General User


Joined: 27 Mar 2008
Posts: 10

PostPosted: Tue Apr 01, 2008 10:04 am    Post subject: move/copy sheet from one calc document to another SOLVED Reply with quote

Hi,
I am sorry I'm posting this question again. I had posted a similar thread in this forum a while back but i thought i screwed up the subject and couldn't edit so i am posting this again.

I need to move all contents( text, formatting) of a sheet to another sheet belonging to another calc document. All of this needs to be done in 'Hidden' mode.

I have tried the below

1) .copyrange(), works only for copying within a calc document
2) functions involving dispatch (captured from recording) , works only in visible mode

Any help in any form will be highly appreciated.

I am terribly sorry if i broke the rules of this forum, I am just desperate.

Thank you


Last edited by bobomonkey_sr on Tue Apr 08, 2008 1:16 am; edited 1 time in total
Back to top
View user's profile Send private message
Villeroy
Super User
Super User


Joined: 04 Oct 2004
Posts: 10106
Location: Germany

PostPosted: Fri Apr 04, 2008 5:01 pm    Post subject: Reply with quote

I just found a solution to this problem. It requires a stored source document.
Code:

REM  *****  BASIC  *****

Sub Main
REM source document
Dim sURL$, sLinkSheetName$
   sURL = thisComponent.getURL()
   sLinkSheetName = "Sheet1"
   
REM target document
Dim doc, sheets, sName$, pos%
   doc = StarDesktop.loadComponentFromURL("private:factory/scalc", "_default",0, Array())
   sheets = doc.getSheets()
   sName = getUniqueName(sheets, "Copied")
   pos = 0

REM new sheet
Dim sh
   sheets.insertNewByName(sName, pos)
   sh = sheets.getByName(sName)
   
REM link the new sheet
   sh.link(sURL, sLinkSheetName, "calc8", "", com.sun.star.sheet.SheetLinkMode.NORMAL)
   
REM break link
   sh.setLinkMode(com.sun.star.sheet.SheetLinkMode.NONE)
End Sub

Function getUniqueName(oContainer,sName$)
Dim i%,sNew$
   sNew = sName
   Do while oContainer.hasByName(sNew)
      i = i +1
      sNew = sName &"_"& i      
   loop
   getUniqueName = sNew
End Function


_________________
Rest in peace, oooforum.org
Get help on https://forum.openoffice.org
Back to top
View user's profile Send private message
bobomonkey_sr
General User
General User


Joined: 27 Mar 2008
Posts: 10

PostPosted: Mon Apr 07, 2008 12:32 am    Post subject: Reply with quote

Thanks a million Villeroy. This works for me.

I have re-wrriten this in VBS

Code:

Function copysheet(sPath,sSheetName,dPath,dSheetName)
Dim StarDesktopObj
Dim workBookObj
Dim OOfilepathsource
Dim OOfilepathdest
OOfilepathSource=FileNameToURL(sPath)
OOfilepathdest=FileNameToURL(dPath)
Set StarDesktopObj=getExcelApplicationObject()
Set workBookObj=getExcelWorkbookObject(StarDesktopObj,dPath)
workBookObj.Sheets.insertNewbyname "sheetForLink",0
Set newsheet=workBookObj.Sheets.getbyname("sheetForLink")
newsheet.link OOfilepathSource, sSheetName, "MS Excel 97", "", 1
newsheet.setLinkMode 0
newsheet.setname dSheetName
WScript.Sleep(3000)
Call saveFile(workBookObj,OOfilepathdest)
WScript.Sleep(5000)
workBookObj.close(False)
Set StarDesktopObj=Nothing
Set workBookObj=Nothing
End Function
'------------------------------------------------------------------------------------------------
Function getExcelApplicationObject()
Dim StarDesktop
Dim CalcApplicationObject
On Error Resume Next
Set StarDesktop=CreateUnoService("com.sun.star.frame.Desktop")
If Err.Number<>0 Then
getExcelApplicationObject=1
Exit Function
End If
Set getExcelApplicationObject=StarDesktop
End Function
'------------------------------------------------------------------------------------------------
Function getExcelWorkbookObject(StarDesktop,xlfilePath)
Dim mPropertyArray(0)
Set mPropertyArray(0)=MakePropertyValue("Hidden", False)

If xlfilePath="newfile" Then
filepathUrl="private:factory/scalc"
Else
filepathUrl=FileNameToURL(xlfilePath)
End If

On error Resume Next
Set CalcApplicationObject=StarDesktop.loadComponentFromURL(filepathUrl,"_blank", 0,mPropertyArray)
'MsgBox Err.Number&"  "&Err.Description
If Err.Number<>0 Then
getExcelWorkbookObject=1
Exit Function
End If
Set getExcelWorkbookObject=CalcApplicationObject
End Function

'------------------------------------------------------------------------------------------------
Function saveFile(wbObj,savefilepathurl)
Dim savePropertyArr(1)
Set savePropertyArr(0)=MakePropertyValue("Overwrite", True)
Set savePropertyArr(1)=MakePropertyValue("FilterName", "MS Excel 97")
wbObj.storeAsURL savefilepathurl, savePropertyArr
End Function

'------------------------------------------------------------------------------------------------
'Function call
sPath="D:\login.xls"
'sSheetname="validLoginCredentials"
sSheetname="INvalidLoginCredentials"
dPath="D:\CreateXLFileWithGivenSheetName.xls"
dSheetname="INvalidLoginCredentials"
Call copysheet(sPath,sSheetName,dPath,dSheetName)
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 Macros and API 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