1<?xml version="1.0" encoding="UTF-8"?>
2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
3<script:module xmlns:script="http://openoffice.org/2000/script" script:name="table_XCellRange" script:language="StarBasic">
4
5
6'*************************************************************************
7'
8' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
9'
10' Copyright 2000, 2010 Oracle and/or its affiliates.
11'
12' OpenOffice.org - a multi-platform office productivity suite
13'
14' This file is part of OpenOffice.org.
15'
16' OpenOffice.org is free software: you can redistribute it and/or modify
17' it under the terms of the GNU Lesser General Public License version 3
18' only, as published by the Free Software Foundation.
19'
20' OpenOffice.org is distributed in the hope that it will be useful,
21' but WITHOUT ANY WARRANTY; without even the implied warranty of
22' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23' GNU Lesser General Public License version 3 for more details
24' (a copy is included in the LICENSE file that accompanied this code).
25'
26' You should have received a copy of the GNU Lesser General Public License
27' version 3 along with OpenOffice.org.  If not, see
28' <http://www.openoffice.org/license.html>
29' for a copy of the LGPLv3 License.
30'
31'*************************************************************************
32'*************************************************************************
33
34
35
36' Be sure that all variables are dimensioned:
37option explicit
38
39'*************************************************************************
40' You can only get ranges within your
41' object-range. That means is your object-range
42' is (A1:C3) you can get only a range within
43' (A1:C3).
44
45'*************************************************************************
46
47
48
49
50
51Sub RunTest()
52
53'*************************************************************************
54' INTERFACE:
55' com.sun.star.table.XCellRange
56'*************************************************************************
57On Error Goto ErrHndl
58    Dim bOK As Boolean
59
60    Dim oCell As Object
61    Dim oCellRange As Object
62    Dim oCellRange1 As Object
63    Dim bSupport As Boolean
64    Dim oAddress As Object
65    Dim nSCol As Long, nECol As Long
66    Dim nSRow As Long, nERow As Long
67    Dim nCol As Long, nRow As Long
68    Dim cSCol As String, cECol As String
69
70    bOK = true
71    'does the object support this service? If yes, the object is a range itself.
72    'So we must look for the range address to be get a valid range
73    if hasUnoInterfaces( oObj, "com.sun.star.sheet.XCellRangeAddressable" ) then
74        Out.Log("Object supports com.sun.star.sheet.XCellRangeAddressable")
75        bSupport = true
76        oAddress = oObj.getRangeAddress()
77        nSCol = oAddress.StartColumn
78        nECol = oAddress.EndColumn
79        nSRow = oAddress.StartRow
80        nERow = oAddress.EndRow
81        nCol = nECol - nSCol
82        nRow = nERow - nSRow
83    else
84        bSupport = false
85        nCol = 1
86        nRow = 1
87    end if
88
89    Test.StartMethod("getCellByPosition()")
90    bOK = true
91    Out.Log("try to getCellByPosition(" + nCol + "," + nRow + ")")
92    oCell = oObj.getCellByPosition(nCol, nRow)
93    bOK = bOK AND hasUnoInterfaces( oCell, "com.sun.star.table.XCell" )
94    Test.MethodTested("getCellByPosition()", bOK)
95
96    Test.StartMethod("getCellRangeByPosition()")
97    bOK = true
98    Out.Log("try to getCellRangeByPosition(0,0," + nCol + "," + nRow + ")")
99    oCellRange = oObj.getCellRangeByPosition(0, 0, nCol, nRow)
100    bOK = bOK AND hasUnoInterfaces( oCellRange, "com.sun.star.table.XCellRange" )
101    Test.MethodTested("getCellRangeByPosition()", bOK)
102
103    Test.StartMethod("getCellRangeByName()")
104    bOK = true
105    if bSupport then
106        oAddress = oObj.getRangeAddress()
107        nSCol = oAddress.StartColumn
108        nECol = oAddress.EndColumn
109        nSRow = oAddress.StartRow
110        nERow = oAddress.EndRow
111        cSCol = getCharacter(nSCol)
112        cECol = getCharacter(nECol)
113    else
114        nSRow = 0
115        nERow = 2
116        cSCol = "A"
117        cECol = "C"
118    end if
119    Out.Log("Try to getCellRangeByName(""" + cSCol + (nSRow + 1) + ":" + cECol + (nERow + 1) + """)")
120    oCellRange1 = oObj.getCellRangeByName("" + cSCol + (nSRow + 1) + ":" + cECol + (nERow + 1))
121    bOK = bOK AND hasUnoInterfaces( oCellRange1, "com.sun.star.table.XCellRange" )
122    Test.MethodTested("getCellRangeByName()", bOK)
123
124Exit Sub
125ErrHndl:
126    Test.Exception()
127    bOK = false
128    resume next
129End Sub
130Function getCharacter( nCol as Integer) as String
131    Dim Char As String
132    Dim nNum As Integer
133    nNum = nCol
134    Char = ""
135    if (nNum - 26) &gt; 0 Then
136        Char = Chr((nNum mod 26)+65)
137        nNum = Int((nNum - 26)/ 26)
138    end if
139    Char = Chr(nNum + 65) + Char
140    getCharacter = Char
141End Function
142</script:module>
143