| View previous topic :: View next topic |
| Author |
Message |
bobomonkey_sr
General User
Joined: 27 Mar 2008
Posts: 10
|
 Posted: Tue Apr 01, 2008 10:04 am Post subject: move/copy sheet from one calc document to another SOLVED |
 |
|
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 |
|
 |
Villeroy
Super User
Joined: 04 Oct 2004
Posts: 10065
Location: Germany
|
| Posted: Fri Apr 04, 2008 5:01 pm Post subject: |
|
|
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 http://forum.openoffice.org |
|
| Back to top |
|
|
bobomonkey_sr
General User
Joined: 27 Mar 2008
Posts: 10
|
| Posted: Mon Apr 07, 2008 12:32 am Post subject: |
|
|
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 |
|
|
|
|
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
|
