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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--
* This file is part of the LibreOffice project.
*
* This Source Code Form is subject to the terms of the Mozilla Public
* License, v. 2.0. If a copy of the MPL was not distributed with this
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
*
* This file incorporates work covered by the following license notice:
*
* Licensed to the Apache Software Foundation (ASF) under one or more
* contributor license agreements. See the NOTICE file distributed
* with this work for additional information regarding copyright
* ownership. The ASF licenses this file to you under the Apache
* License, Version 2.0 (the "License"); you may not use this file
* except in compliance with the License. You may obtain a copy of
* the License at http://www.apache.org/licenses/LICENSE-2.0 .
-->
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM ***** BASIC *****
Option Explicit
Sub RemoveSheet()
If oSheets.HasbyName("Link") then
oSheets.RemovebyName("Link")
End If
End Sub
Sub InitializeStatusLine(StatusText as String, MaxValue as Integer, FirstValue as Integer)
oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator()
oStatusLine.Start(StatusText, MaxValue)
oStatusline.SetValue(FirstValue)
End Sub
Sub MakeRangeVisible(oSheet as Object, RangeName as String, BIsVisible as Boolean)
Dim oRangeAddress, oColumns as Object
Dim i, iStartColumn, iEndColumn as Integer
oRangeAddress = oSheet.GetCellRangeByName(RangeName).RangeAddress
iStartColumn = oRangeAddress.StartColumn
iEndColumn = oRangeAddress.EndColumn
oColumns = oSheet.Columns
For i = iStartColumn To iEndColumn
oSheet.Columns(i).IsVisible = bIsVisible
Next i
End Sub
Function GetRowIndex(oSheet as Object, RowName as String)
Dim oRange as Object
oRange = oSheet.GetCellRangeByName(RowName)
GetRowIndex = oRange.RangeAddress.StartRow
End Function
Function GetTransactionCount(iStartRow as Integer)
Dim iEndRow as Integer
iStartRow = GetRowIndex(oMovementSheet, "ColumnsToHide")
iEndRow = GetRowIndex(oMovementSheet, "HiddenRow3" )
GetTransactionCount = iEndRow -iStartRow - 2
End Function
Function GetStocksCount(iStartRow as Integer)
Dim iEndRow as Integer
iStartRow = GetRowIndex(oFirstSheet, "HiddenRow1")
iEndRow = GetRowIndex(oFirstSheet, "HiddenRow2")
GetStocksCount = iEndRow -iStartRow - 1
End Function
Function FillListbox(ListboxControl as Object, MsgTitle as String, bShowMessage) as Boolean
Dim i, StocksCount as Integer
Dim iStartRow as Integer
Dim oCell as Object
' Add stock names to empty list box
StocksCount = GetStocksCount(iStartRow)
If StocksCount > 0 Then
ListboxControl.Model.StringItemList() = NullList()
For i = 1 To StocksCount
oCell = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1,iStartRow + i)
ListboxControl.AddItem(oCell.String, i-1)
Next
FillListbox() = True
Else
If bShowMessage Then
Msgbox(sInsertStockName, 16, MsgTitle)
FillListbox() = False
End If
End If
End Function
Sub CellValuetoControl(oSheet, oControl as Object, CellName as String)
Dim oCell as Object
Dim StringValue
oCell = GetCellByName(oSheet, CellName)
If oControl.PropertySetInfo.HasPropertyByName("EffectiveValue") Then
oControl.EffectiveValue = oCell.Value
Else
oControl.Value = oCell.Value
End If
' If oCell.FormulaResultType = 1 Then
' StringValue = oNumberFormatter.GetInputString(oCell.NumberFormat, oCell.Value)
' oControl.Text = DeleteStr(StringValue, "%")
' Else
' oControl.Text = oCell.String
' End If
End Sub
Sub RemoveStockRows(oSheet as Object, iStartRow, RowCount as Integer)
If RowCount > 0 Then
oSheet.Rows.RemoveByIndex(iStartRow, RowCount)
End If
End Sub
Sub AddValueToCellContent(iCellCol, iCellRow as Integer, AddValue)
Dim oCell as Object
Dim OldValue
oCell = oMovementSheet.GetCellByPosition(iCellCol, iCellRow)
OldValue = oCell.Value
oCell.Value = OldValue + AddValue
End Sub
Sub CheckInputDate(aEvent as Object)
Dim oRefDialog as Object
Dim oRefModel as Object
Dim oDateModel as Object
oDateModel = aEvent.Source.Model
oRefModel = DlgReference.GetControl("cmdGoOn").Model
oRefModel.Enabled = oDateModel.Date <> 0
End Sub
' Updates the cell with the CurrentValue after checking if the
' Newdate is later than the one that is referred to in the annotation
' of the cell
Sub InsertCurrentValue(CurValue as Double, iRow as Integer, Newdate as Date)
Dim oCell as Object
Dim OldDate as Date
oCell = oFirstSheet.GetCellByPosition(SBCOLUMNRATE1, iRow)
OldDate = CDate(oCell.Annotation.Text.String)
If NewDate >= OldDate Then
oCell.SetValue(CurValue)
oCell.Annotation.Text.SetString(CStr(NewDate))
End If
End Sub
Sub SplitCellValue(oSheet, FirstNumber, SecondNumber, iCol, iRow, NoteText)
Dim oCell as Object
Dim OldValue
oCell = oSheet.GetCellByPosition(iCol, iRow)
OldValue = oCell.Value
oCell.Value = OldValue * FirstNumber / SecondNumber
If NoteText <> "" Then
oCell.Annotation.SetString(NoteText)
End If
End Sub
Function GetStockRowIndex(ByVal Stockname) as Integer
Dim i, StocksCount as Integer
Dim iStartRow as Integer
Dim oCell as Object
StocksCount = GetStocksCount(iStartRow)
For i = 1 To StocksCount
oCell = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1,iStartRow + i)
If oCell.String = Stockname Then
GetStockRowIndex = iStartRow + i
Exit Function
End If
Next
GetStockRowIndex = -1
End Function
Function GetStockID(StockName as String, Optional iFirstRow as Integer) as String
Dim CellStockName as String
Dim i as Integer
Dim iCount as Integer
Dim iLastRow as Integer
If IsMissing(iFirstRow) Then
iFirstRow = GetRowIndex(oFirstSheet, "HiddenRow1")
End If
iCount = GetStocksCount(iFirstRow)
iLastRow = iFirstRow + iCount
For i = iFirstRow To iLastRow
CellStockName = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1, i).String
If CellStockname = StockName Then
Exit For
End If
Next i
If i > iLastRow Then
GetStockID() = ""
Else
If Not IsMissing(iFirstRow) Then
iFirstRow = i
End If
GetStockID() = oFirstSheet.GetCellByPosition(SBCOLUMNID1, i).String
End If
End Function
Function CheckDocLocale(LocLanguage as String, LocCountry as String)
Dim bIsDocLanguage as Boolean
Dim bIsDocCountry as Boolean
bIsDocLanguage = Instr(1, LocLanguage, sDocLanguage, SBBINARY) <> 0
bIsDocCountry = Instr(1, LocCountry, sDocCountry, SBBINARY) <> 0 OR SDocCountry = ""
CheckDocLocale = (bIsDocLanguage And bIsDocCountry)
End Function
</script:module>
|
