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
37' Be sure that all variables are dimensioned:
38option explicit
39
40'*************************************************************************
41' You can only get ranges within your
42' object-range. That means is your object-range
43' is (A1:C3) you can get only a range within
44' (A1:C3).
45
46'*************************************************************************
47
48
49
50
51
52Sub RunTest()
53
54'*************************************************************************
55' INTERFACE:
56' com.sun.star.table.XCellRange
57'*************************************************************************
58On Error Goto ErrHndl
59    Dim bOK As Boolean
60
61    Dim oCell As Object
62    Dim oCellRange As Object
63    Dim oCellRange1 As Object
64    Dim bSupport As Boolean
65    Dim oAddress As Object
66    Dim nSCol As Long, nECol As Long
67    Dim nSRow As Long, nERow As Long
68    Dim nCol As Long, nRow As Long
69    Dim cSCol As String, cECol As String
70
71    bOK = true
72    'does the object support this service? If yes, the object is a range itself.
73    'So we must look for the range address to be get a valid range
74    if hasUnoInterfaces( oObj, "com.sun.star.sheet.XCellRangeAddressable" ) then
75        Out.Log("Object supports com.sun.star.sheet.XCellRangeAddressable")
76        bSupport = true
77        oAddress = oObj.getRangeAddress()
78        nSCol = oAddress.StartColumn
79        nECol = oAddress.EndColumn
80        nSRow = oAddress.StartRow
81        nERow = oAddress.EndRow
82        nCol = nECol - nSCol
83        nRow = nERow - nSRow
84    else
85        bSupport = false
86        nCol = 1
87        nRow = 1
88    end if
89
90    Test.StartMethod("getCellByPosition()")
91    bOK = true
92    Out.Log("try to getCellByPosition(" + nCol + "," + nRow + ")")
93    oCell = oObj.getCellByPosition(nCol, nRow)
94    bOK = bOK AND hasUnoInterfaces( oCell, "com.sun.star.table.XCell" )
95    Test.MethodTested("getCellByPosition()", bOK)
96
97    Test.StartMethod("getCellRangeByPosition()")
98    bOK = true
99    Out.Log("try to getCellRangeByPosition(0,0," + nCol + "," + nRow + ")")
100    oCellRange = oObj.getCellRangeByPosition(0, 0, nCol, nRow)
101    bOK = bOK AND hasUnoInterfaces( oCellRange, "com.sun.star.table.XCellRange" )
102    Test.MethodTested("getCellRangeByPosition()", bOK)
103
104    Test.StartMethod("getCellRangeByName()")
105    bOK = true
106    if bSupport then
107        oAddress = oObj.getRangeAddress()
108        nSCol = oAddress.StartColumn
109        nECol = oAddress.EndColumn
110        nSRow = oAddress.StartRow
111        nERow = oAddress.EndRow
112        cSCol = getCharacter(nSCol)
113        cECol = getCharacter(nECol)
114    else
115        nSRow = 0
116        nERow = 2
117        cSCol = "A"
118        cECol = "C"
119    end if
120    Out.Log("Try to getCellRangeByName(""" + cSCol + (nSRow + 1) + ":" + cECol + (nERow + 1) + """)")
121    oCellRange1 = oObj.getCellRangeByName("" + cSCol + (nSRow + 1) + ":" + cECol + (nERow + 1))
122    bOK = bOK AND hasUnoInterfaces( oCellRange1, "com.sun.star.table.XCellRange" )
123    Test.MethodTested("getCellRangeByName()", bOK)
124
125Exit Sub
126ErrHndl:
127    Test.Exception()
128    bOK = false
129    resume next
130End Sub
131Function getCharacter( nCol as Integer) as String
132    Dim Char As String
133    Dim nNum As Integer
134    nNum = nCol
135    Char = ""
136    if (nNum - 26) &gt; 0 Then
137        Char = Chr((nNum mod 26)+65)
138        nNum = Int((nNum - 26)/ 26)
139    end if
140    Char = Chr(nNum + 65) + Char
141    getCharacter = Char
142End Function
143</script:module>
144