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