Freelog 52/Freelog052.iso/Dossier/OpenOffice/f_0214/tools.xba

Extensible Markup Language | 2002-09-17 | 6KB | 200 lines

<?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="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, 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>