<?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 refered 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>