tools.xba 6.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217
  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <!--
  4. * This file is part of the LibreOffice project.
  5. *
  6. * This Source Code Form is subject to the terms of the Mozilla Public
  7. * License, v. 2.0. If a copy of the MPL was not distributed with this
  8. * file, You can obtain one at http://mozilla.org/MPL/2.0/.
  9. *
  10. * This file incorporates work covered by the following license notice:
  11. *
  12. * Licensed to the Apache Software Foundation (ASF) under one or more
  13. * contributor license agreements. See the NOTICE file distributed
  14. * with this work for additional information regarding copyright
  15. * ownership. The ASF licenses this file to you under the Apache
  16. * License, Version 2.0 (the "License"); you may not use this file
  17. * except in compliance with the License. You may obtain a copy of
  18. * the License at http://www.apache.org/licenses/LICENSE-2.0 .
  19. -->
  20. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM ***** BASIC *****
  21. Option Explicit
  22. Sub RemoveSheet()
  23. If oSheets.HasbyName(&quot;Link&quot;) then
  24. oSheets.RemovebyName(&quot;Link&quot;)
  25. End If
  26. End Sub
  27. Sub InitializeStatusLine(StatusText as String, MaxValue as Integer, FirstValue as Integer)
  28. oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator()
  29. oStatusLine.Start(StatusText, MaxValue)
  30. oStatusline.SetValue(FirstValue)
  31. End Sub
  32. Sub MakeRangeVisible(oSheet as Object, RangeName as String, BIsVisible as Boolean)
  33. Dim oRangeAddress, oColumns as Object
  34. Dim i, iStartColumn, iEndColumn as Integer
  35. oRangeAddress = oSheet.GetCellRangeByName(RangeName).RangeAddress
  36. iStartColumn = oRangeAddress.StartColumn
  37. iEndColumn = oRangeAddress.EndColumn
  38. oColumns = oSheet.Columns
  39. For i = iStartColumn To iEndColumn
  40. oSheet.Columns(i).IsVisible = bIsVisible
  41. Next i
  42. End Sub
  43. Function GetRowIndex(oSheet as Object, RowName as String)
  44. Dim oRange as Object
  45. oRange = oSheet.GetCellRangeByName(RowName)
  46. GetRowIndex = oRange.RangeAddress.StartRow
  47. End Function
  48. Function GetTransactionCount(iStartRow as Integer)
  49. Dim iEndRow as Integer
  50. iStartRow = GetRowIndex(oMovementSheet, &quot;ColumnsToHide&quot;)
  51. iEndRow = GetRowIndex(oMovementSheet, &quot;HiddenRow3&quot; )
  52. GetTransactionCount = iEndRow -iStartRow - 2
  53. End Function
  54. Function GetStocksCount(iStartRow as Integer)
  55. Dim iEndRow as Integer
  56. iStartRow = GetRowIndex(oFirstSheet, &quot;HiddenRow1&quot;)
  57. iEndRow = GetRowIndex(oFirstSheet, &quot;HiddenRow2&quot;)
  58. GetStocksCount = iEndRow -iStartRow - 1
  59. End Function
  60. Function FillListbox(ListboxControl as Object, MsgTitle as String, bShowMessage) as Boolean
  61. Dim i, StocksCount as Integer
  62. Dim iStartRow as Integer
  63. Dim oCell as Object
  64. &apos; Add stock names to empty list box
  65. StocksCount = GetStocksCount(iStartRow)
  66. If StocksCount &gt; 0 Then
  67. ListboxControl.Model.StringItemList() = NullList()
  68. For i = 1 To StocksCount
  69. oCell = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1,iStartRow + i)
  70. ListboxControl.AddItem(oCell.String, i-1)
  71. Next
  72. FillListbox() = True
  73. Else
  74. If bShowMessage Then
  75. Msgbox(sInsertStockName, 16, MsgTitle)
  76. FillListbox() = False
  77. End If
  78. End If
  79. End Function
  80. Sub CellValuetoControl(oSheet, oControl as Object, CellName as String)
  81. Dim oCell as Object
  82. Dim StringValue
  83. oCell = GetCellByName(oSheet, CellName)
  84. If oControl.PropertySetInfo.HasPropertyByName(&quot;EffectiveValue&quot;) Then
  85. oControl.EffectiveValue = oCell.Value
  86. Else
  87. oControl.Value = oCell.Value
  88. End If
  89. &apos; If oCell.FormulaResultType = 1 Then
  90. &apos; StringValue = oNumberFormatter.GetInputString(oCell.NumberFormat, oCell.Value)
  91. &apos; oControl.Text = DeleteStr(StringValue, &quot;%&quot;)
  92. &apos; Else
  93. &apos; oControl.Text = oCell.String
  94. &apos; End If
  95. End Sub
  96. Sub RemoveStockRows(oSheet as Object, iStartRow, RowCount as Integer)
  97. If RowCount &gt; 0 Then
  98. oSheet.Rows.RemoveByIndex(iStartRow, RowCount)
  99. End If
  100. End Sub
  101. Sub AddValueToCellContent(iCellCol, iCellRow as Integer, AddValue)
  102. Dim oCell as Object
  103. Dim OldValue
  104. oCell = oMovementSheet.GetCellByPosition(iCellCol, iCellRow)
  105. OldValue = oCell.Value
  106. oCell.Value = OldValue + AddValue
  107. End Sub
  108. Sub CheckInputDate(aEvent as Object)
  109. Dim oRefDialog as Object
  110. Dim oRefModel as Object
  111. Dim oDateModel as Object
  112. oDateModel = aEvent.Source.Model
  113. oRefModel = DlgReference.GetControl(&quot;cmdGoOn&quot;).Model
  114. oRefModel.Enabled = oDateModel.Date &lt;&gt; 0
  115. End Sub
  116. &apos; Updates the cell with the CurrentValue after checking if the
  117. &apos; Newdate is later than the one that is referred to in the annotation
  118. &apos; of the cell
  119. Sub InsertCurrentValue(CurValue as Double, iRow as Integer, Newdate as Date)
  120. Dim oCell as Object
  121. Dim OldDate as Date
  122. oCell = oFirstSheet.GetCellByPosition(SBCOLUMNRATE1, iRow)
  123. OldDate = CDate(oCell.Annotation.Text.String)
  124. If NewDate &gt;= OldDate Then
  125. oCell.SetValue(CurValue)
  126. oCell.Annotation.Text.SetString(CStr(NewDate))
  127. End If
  128. End Sub
  129. Sub SplitCellValue(oSheet, FirstNumber, SecondNumber, iCol, iRow, NoteText)
  130. Dim oCell as Object
  131. Dim OldValue
  132. oCell = oSheet.GetCellByPosition(iCol, iRow)
  133. OldValue = oCell.Value
  134. oCell.Value = OldValue * FirstNumber / SecondNumber
  135. If NoteText &lt;&gt; &quot;&quot; Then
  136. oCell.Annotation.SetString(NoteText)
  137. End If
  138. End Sub
  139. Function GetStockRowIndex(ByVal Stockname) as Integer
  140. Dim i, StocksCount as Integer
  141. Dim iStartRow as Integer
  142. Dim oCell as Object
  143. StocksCount = GetStocksCount(iStartRow)
  144. For i = 1 To StocksCount
  145. oCell = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1,iStartRow + i)
  146. If oCell.String = Stockname Then
  147. GetStockRowIndex = iStartRow + i
  148. Exit Function
  149. End If
  150. Next
  151. GetStockRowIndex = -1
  152. End Function
  153. Function GetStockID(StockName as String, Optional iFirstRow as Integer) as String
  154. Dim CellStockName as String
  155. Dim i as Integer
  156. Dim iCount as Integer
  157. Dim iLastRow as Integer
  158. If IsMissing(iFirstRow) Then
  159. iFirstRow = GetRowIndex(oFirstSheet, &quot;HiddenRow1&quot;)
  160. End If
  161. iCount = GetStocksCount(iFirstRow)
  162. iLastRow = iFirstRow + iCount
  163. For i = iFirstRow To iLastRow
  164. CellStockName = oFirstSheet.GetCellByPosition(SBCOLUMNNAME1, i).String
  165. If CellStockname = StockName Then
  166. Exit For
  167. End If
  168. Next i
  169. If i &gt; iLastRow Then
  170. GetStockID() = &quot;&quot;
  171. Else
  172. If Not IsMissing(iFirstRow) Then
  173. iFirstRow = i
  174. End If
  175. GetStockID() = oFirstSheet.GetCellByPosition(SBCOLUMNID1, i).String
  176. End If
  177. End Function
  178. Function CheckDocLocale(LocLanguage as String, LocCountry as String)
  179. Dim bIsDocLanguage as Boolean
  180. Dim bIsDocCountry as Boolean
  181. bIsDocLanguage = Instr(1, LocLanguage, sDocLanguage, SBBINARY) &lt;&gt; 0
  182. bIsDocCountry = Instr(1, LocCountry, sDocCountry, SBBINARY) &lt;&gt; 0 OR SDocCountry = &quot;&quot;
  183. CheckDocLocale = (bIsDocLanguage And bIsDocCountry)
  184. End Function
  185. </script:module>