'************************************************************************* ' ' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. ' ' Copyright 2008 by Sun Microsystems, Inc. ' ' OpenOffice.org - a multi-platform office productivity suite ' ' $RCSfile: sheet_XAreaLink.xba,v $ ' ' $Revision: 1.3 $ ' ' This file is part of OpenOffice.org. ' ' OpenOffice.org is free software: you can redistribute it and/or modify ' it under the terms of the GNU Lesser General Public License version 3 ' only, as published by the Free Software Foundation. ' ' OpenOffice.org is distributed in the hope that it will be useful, ' but WITHOUT ANY WARRANTY; without even the implied warranty of ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ' GNU Lesser General Public License version 3 for more details ' (a copy is included in the LICENSE file that accompanied this code). ' ' You should have received a copy of the GNU Lesser General Public License ' version 3 along with OpenOffice.org. If not, see ' ' for a copy of the LGPLv3 License. ' '************************************************************************* '************************************************************************* Sub RunTest() '************************************************************************* ' INTERFACE: ' com.sun.star.sheet.XAreaLink '************************************************************************* On Error Goto ErrHndl Dim bOK As Boolean Test.StartMethod("getSourceArea()") bOK = true Dim cArea As String cArea = oObj.getSourceArea() bOK = bOK AND NOT isNULL(cArea) Test.MethodTested("getSourceArea()", bOK) Test.StartMethod("setSourceArea()") bOK = true Dim oldArea As String Dim newArea As String oldArea = oObj.getSourceArea() newArea = "Sheet0.I6:G8" Out.Log("Set SourceArea to '" & newArea & "'") oObj.setSourceArea(newArea) newArea = oObj.getSourceArea() Out.Log("SourceArea is '" & newArea & "'") bOK = bOK AND oldArea <> newArea oObj.setSourceArea(oldArea) Test.MethodTested("setSourceArea()", bOK) Test.StartMethod("getDestArea()") Dim oArea As Object bOK = true oArea = oObj.getDestArea() bOK = bOK AND NOT isNULL(oArea) Test.MethodTested("getDestArea()", bOK) Test.StartMethod("setDestArea()") Dim sNewArea As New com.sun.star.table.CellRangeAddress Dim sOldArea As Object bOK = true sOldArea = oObj.getDestArea() sNewArea.Sheet = sOldArea.Sheet sNewArea.StartRow = sOldArea.StartRow + 1 sNewArea.StartColumn = sOldArea.StartColumn + 1 sNewArea.EndRow = sOldArea.EndRow + 1 sNewArea.EndColumn = sOldArea.EndColumn + 1 oObj.setDestArea(sNewArea) bOK = bOK AND NOT isNULL(oObj.getDestArea()) if (bOK) then bOK = bOK AND (sOldArea.Sheet = oObj.getDestArea.Sheet) bOK = bOK AND (sOldArea.StartRow = oObj.getDestArea.StartRow - 1) bOK = bOK AND (sOldArea.StartColumn = oObj.getDestArea.StartColumn - 1) bOK = bOK AND (sOldArea.EndRow = oObj.getDestArea.EndRow - 1) bOK = bOK AND (sOldArea.EndColumn = oObj.getDestArea.EndColumn - 1) end if oObj.setDestArea(sOldArea) Test.MethodTested("setDestArea()", bOK) Exit Sub ErrHndl: Test.Exception() bOK = false resume next End Sub