DOS/V Power Report 2004 June/VPR0406.ISO/STARSUITE7/EVALUATION/windows/office7/f_0449/carmoney.stc/Basic/Standard/Functions.xml

Extensible Markup Language | 2002-05-14 | 8KB | 257 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="Functions" script:language="StarBasic">Option Explicit

Global oDocument as Object
Global oSheets as Object
Global sDocLanguage as String
Global PeriodList(3) as Double


Sub Initialize()
Dim oFamily as Object
Dim aStyleFormat as Object
Dim oStyle as Object
    GlobalScope.BasicLibraries.LoadLibrary("Tools")
    oDocument = ThisComponent
    oFamily = oDocument.StyleFamilies.GetByIndex(0)
    oStyle = oFamily.GetbyName("Default")
    aStyleFormat = oDocument.NumberFormats.getByKey(oStyle.NumberFormat)
    sDocLanguage = aStyleFormat.Locale.Language
    oSheets = oDocument.Sheets
    PeriodList(0) = 0.0833333
    PeriodList(1) = 1
    PeriodList(2) = 2
    PeriodList(3) = 3
End Sub


' This sub changes the styles of two cells and their contents
' from a formula to a numerical value and vice versa
Sub SetPOT(aEvent as Object)
Dim i, Down, Workline As Integer
Dim iNextCellValue as Double
Dim sCellFormula As String
Dim oSheet as Object
Dim oCell as Object
Dim oNextCell as Object
Dim RefFormula(3) as String
Const SBFIRSTCOL = 3
Const SBFIRSTROW = 13
    Down = aEvent.Source.Model.TabIndex
    Workline = SBFIRSTROW + Down

    RefFormula(0) =    "=EWorkline/12"
    RefFormula(1) = "=FWorkline/2"
    RefFormula(2) =    "=GWorkline*2/3"
    RefFormula(3) =    "=DWorkline*36"

    oDocument.AddActionLock()
    oSheet = oSheets.GetbyIndex(0)
    oSheet.Unprotect("")
    For i = 0 To 3
        oCell = oSheet.GetCellbyPosition(SBFIRSTCOL + i, Workline)
        If oCell.CellStyle = InputStyle Then
            If i < 3 Then
                oNextCell = oSheet.GetCellbyPosition(SBFIRSTCOL + i + 1, Workline)
            Else
                oNextCell = oSheet.GetCellbyPosition(SBFIRSTCOL, Workline)
            End If
            iNextCellValue = oNextCell.Value
            oNextCell.CellStyle = InputStyle
            oNextCell.Formula = ""
            oNextCell.Value = iNextCellValue
            oCell.CellStyle = CalcStyle
            sCellFormula = ReplaceString(RefFormula(i), CStr(Workline+1),"Workline")
            oCell.Formula = sCellFormula
            Exit For
        End If
    Next i
    oSheet.Protect("")
    oDocument.RemoveActionLock()
    oDocument.CalculateAll
End Sub



Sub CopySheet
Dim TableName as String
Dim Separator as String
Dim oSheet as Object
Dim oNewSheet as object
    oSheet = oDocument.CurrentController.ActiveSheet
    ' Copy current sheet
    ' Rename new sheet with its title, replace ".", "-" and "/" by "_"
    TableName = oSheet.GetCellbyPosition(2,2).String
    TableName = CheckNewSheetname(oSheets, TableName, oDocument.CharLocale)
    oSheet.Unprotect("")
    oNewSheet = CopySheetbyName(oSheets, oSheet.Name, TableName, oSheets.Count)
    ClearReceipts
    oNewSheet.Protect("")
    oSheet.protect("")
End Sub



' This sub clears all data on the costs overview sheet
Sub ClearCosts
Dim oSheet as Object
    oSheet = oSheets(0)
    oSheet.Unprotect("")
    ChangeValueofRange(oSheet, "Costs", 0)
    ChangeValueofRange(oSheet, "Price", 0)
    ChangeValueofRange(oSheet, "Consumption", 0)
    ChangeValueofRange(oSheet, "Mileage", 0)
    ChangeValueofRange(oSheet, "Car", "")
    oSheet.Protect("")
End Sub


' This sub clears the data on the current gas bills sheet
Sub ClearReceipts
Dim oSheet as Object
    oSheet = oDocument.CurrentController.GetActiveSheet
    oDocument.AddActionLock()
    oSheet.Unprotect("")
    ChangeValueofRange(oSheet, oSheet.Name & "." & SBRECEIPTRANGE, "")
    ChangeValueofRange(oSheet, oSheet.Name & "." & "I8:I8", "")
    oSheet.Protect("")
    oDocument.RemoveActionLock()
End Sub



' The CheckGas function and the CheckConsumption function are invoked by checking
' the validity of the data entered into the respective cells.
' This function calculates the money spent on gasoline.
' It is called whenever a value for mileage, consuption or
' price for gas is being changed
Function CheckGas (Value, Pos)
Dim oSheet, oController, oCell as Object
Dim Mileage, Consumption, Price, Gasoline as Double
Dim i as Integer
Dim SheetName as String
    InsertValueToSelectedCell(Value)
    oSheet = oSheets(0)
    Mileage = GetValueofCellbyName(oSheet, "Mileage")
    Consumption = GetValueofCellbyName(oSheet, "Consumption")
    Price = GetValueofCellbyName(oSheet, "Price")
    If Mileage <> 0 AND Consumption <> 0 AND Price <> 0 Then 'Avoid miscalculation
        Select Case sDocLanguage
            Case "en", "ja", "ko"
                Gasoline = (Mileage / Consumption) * Price
            Case Else
                Gasoline = (Mileage / 100) * Consumption * Price
        End Select
        ' Recalculate the monthly, yearly etc. consumption of gasoline
        SheetName = oSheet.Name
        For i = 0 To Ubound(PeriodList())
            oCell = oSheet.GetCellbyPosition(i + 3, 14)
            If Instr(1,oCell.Formula, "=") = 0 Then
                oCell.Value = Gasoline *  PeriodList(i)
                Exit For
            End If
        Next i
    End If
    CheckGas = False
End Function


Sub InsertValuetoSelectedCell(CurValue)
Dim oCell, oSheet as Object
Dim dblValue as Double
    On Local ERROR GOTO CELLISNULL
    dblValue = CDbl(CurValue)
    oSheet = oDocument.GetCurrentController.GetActiveSheet()
    oCell = oDocument.GetCurrentController.Selection
    oCell.Value = dblValue
CELLISNULL:
' CDbl throws an exception when the parameter is a valueless string
    If Err <> 0 Then
        Resume Next
    End If
End Sub

' This function calculates consumption of gasoline
' It is called whenever a value for the money spent
' on gas is being changed
Function CheckConsumption (Value, Pos)
Dim GasMoney as Double
Dim Mileage as Double
Dim Price as Double
Dim NewConsump as Double
Dim oSheet, oController, oCell as Object
    oSheet = oSheets(0)

    InsertValuetoSelectedCell(Value)
    Mileage = GetValueofCellbyName(oSheet, "Mileage")
    Price = GetValueofCellbyName(oSheet, "Price")

    oCell = oSheet.GetCellbyPosition(4, 14)
    GasMoney = oCell.Value
    If Mileage <> 0 AND GasMoney <> 0 AND Price <> 0 Then 'Avoid miscalculation
        Select Case sDocLanguage
            Case "en", "ja", "ko"
                NewConsump = (Mileage / (GasMoney / Price))
            Case Else
                NewConsump = (((GasMoney / Price) / Mileage) * 100)
        End Select
        ChangeValueofRange(oSheet, "Consumption",NewConsump)
    End If
    CheckConsumption = False
End Function



' This function is invoked by entering data in one of the cells for fuel bought,
' price per liter and total costs on a Gas Bills sheet. As soon as two of the
' three values are provided, the remaining value will be calculated.
Function EnterGasBill (Value, Pos)
Dim oSheet as Object
Dim Column%, Row%, Table%
Dim Liters as Double
Dim Price as Double
Dim Total as Double
Dim iCellCol as Integer
Dim iCellRow as Integer

    InsertValuetoSelectedCell(Value)
    oSheet = oDocument.GetCurrentController.GetActiveSheet
    iCellCol = oDocument.GetCurrentController.GetSelection.RangeAddress.StartColumn
    iCellRow = oDocument.GetCurrentController.GetSelection.RangeAddress.StartRow

    Liters = oSheet.GetCellbyPosition(5, iCellRow).Value
    Price = oSheet.GetCellbyPosition(6, iCellRow).Value
    Total = oSheet.GetCellbyPosition(7, iCellRow).Value
    Select Case iCellCol
        Case 5 ' Liters entered
            ' Change the Values in column 7 and 8
            If Price <> 0 Then
                Total = Price*Liters
                oSheet.GetCellbyPosition(7,iCellRow).Value = Total
            Elseif Total<>0 Then
                Price = Total/Liters
                oSheet.GetCellbyPosition(6,iCellRow).Value = Price
            End If

        Case 6 ' Price entered
            ' Change the Values in column 6 and 8
            If Liters <> 0 Then
                Total = Price*Liters
                oSheet.GetCellbyPosition(7, iCellRow).Value = Total
            Elseif Total<>0 Then
                Liters = Total/Price
                oSheet.GetCellbyPosition(5,iCellRow).Value = Liters
            End If

        Case 7 ' Total costs entered
            ' Change the Values in column 6 and 7
            If Liters <> 0 Then
                Price = Total/Liters
                oSheet.GetCellbyPosition(6, iCellRow).Value = Price
            Elseif Price <> 0 Then
                Liters = Total/Price
                oSheet.GetCellbyPosition(5,iCellRow).Value =  Liters
            End If
    End Select
End Function</script:module>