Option Explicit Sub Initialize(Optional bChooseMarketPlace as Boolean) Dim bEnableHistory as Boolean GlobalScope.BasicLibraries.LoadLibrary("Tools") ' oMarketModel = GetControlModel(oDocument.Sheets(0), "CmdHistory") ' bEnableHistory = oMarketModel.Enabled ToggleWindow(False) Today = Date() bDebugmode = False oDocument = ThisComponent oController = oDocument.GetCurrentController oSheets = oDocument.Sheets oFirstSheet = oSheets(0) oMovementSheet = oSheets(1) oBankSheet = oSheets(2) oDocFormats = oDocument.NumberFormats oNumberFormatter = CreateUnoService("com.sun.star.util.NumberFormatter") oNumberFormatter.AttachNumberFormatsSupplier(oDocument) oDocLocale = oDocument.CharLocale sDocLanguage = oDocLocale.Language sDocCountry = oDocLocale.Country LoadLanguage() ToggleWindow(True) ' oMarketModel.Enabled = bEnableHistory If Not IsMissing(bChooseMarketPlace) Then If bChoosemarketPlace Then ChooseMarket() End If Else ChooseMarket() End If If Not IsMissing(bChooseMarketPlace) Then If bChooseMarketPlace Then oMarketModel.Enabled = bEnableMarket oInternetModel.Enabled = bEnableInternet End If End If End Sub Sub Buy() Initialize(True) FillListbox(DlgTransaction.GetControl("lstBuyStocks"), TransactTitle(SBDIALOGBUY), False) SetupTransactionControls(SBDIALOGBUY) EnableTransactionControls(False) DlgTransaction.Execute() End Sub Sub Sell() Initialize(True) If FillListbox(DlgTransaction.GetControl("lstSellStocks"), TransactTitle(SBDIALOGSELL), True) Then SetupTransactionControls(SBDIALOGSELL) EnableTransactionControls(False) DlgTransaction.Execute() End If End Sub Sub Reset() Dim TransactionCount as Integer Dim StockCount, iStartRow, i as Integer Dim oRows, oRange as Object Dim StockName as String Initialize(True) ' Delete transactions and reset overview If MsgBox(sMsgDeleteAll, SBMSGYESNO+SBMSGQUESTION+SBMSGDEFAULTBTN2, sMsgAuthorization) = 6 Then ' Assumption: If and only if there is an overview, then there are transactions, too UnprotectSheets(oSheets) StockCount = GetStocksCount(iStartRow) For i = 1 To StockCount StockName = oFirstSheet.GetCellbyPosition(SBCOLUMNNAME1, iStartRow + i).String If oSheets.HasbyName(StockName) Then oSheets.RemoveByName(StockName) End If Next oDocument.AddActionLock RemoveStockRows(oFirstSheet, iStartRow + 1, StockCount) TransactionCount = GetTransactionCount(iStartRow) RemoveStockRows(oMovementSheet, iStartRow + 2, TransactionCount) ProtectSheets(oSheets) oDocument.RemoveActionLock End If End Sub Sub TransactionOk Dim Sold as Long Dim RestQuantity, Value, PartialValue, Profit Dim iNewRow as Integer, iRow as Integer Dim iStockRow as Long, iRestQuantity as Long Dim oNameCell as Object Dim CellStockName as String, SelStockName as String Dim CurRate as Double Dim TransactDate as Date Dim LocStockName as String ' Check for rate entered If TransactModel.txtRate.Value = 0 Then If TransactModel.Step = SBDIALOGBUY Then If MsgBox(sMsgFreeStock, SBMSGYESNO+SBMSGQUESTION, sMsgConfirm)=7 Then Exit Sub End If Else If MsgBox(sMsgTotalLoss, SBMSGYESNO+SBMSGQUESTION, sMsgConfirm)=7 Then Exit Sub End If End If End If CurRate = TransactModel.txtRate.Value TransactDate = CDateFromISO(TransactModel.txtDate.Date) DlgTransaction.EndExecute() UnprotectSheets(oSheets) iNewRow = DuplicateRow(oMovementSheet, "HiddenRow3") If TransactModel.Step = SBDIALOGBUY Then CellStockName = TransactModel.lstBuyStocks.Text If Instr(1,CellStockName,"$") <> 0 Then CellStockName = "'" & CellStockName & "'" End If oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iNewRow).String = CellStockName oMovementSheet.GetCellByPosition(SBCOLUMNQUANTITY2, iNewRow).Value = TransactModel.txtQuantity.Value Else CellStockName = DlgTransaction.GetControl("lstSellStocks").GetSelectedItem() oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iNewRow).String = CellStockName oMovementSheet.GetCellByPosition(SBCOLUMNQUANTITY2, iNewRow).Value = -TransactModel.txtQuantity.Value End If oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iNewRow).Value = CDateFromISO(TransactModel.txtDate.Date) oMovementSheet.GetCellByPosition(SBCOLUMNRATE2, iNewRow).Value = TransactModel.txtRate.Value oMovementSheet.GetCellByPosition(SBCOLUMNPROVPERCENT2, iNewRow).Value = TransactModel.txtCommission.EffectiveValue oMovementSheet.GetCellByPosition(SBCOLUMNPROVMIN2, iNewRow).Value = TransactModel.txtMinimum.Value oMovementSheet.GetCellByPosition(SBCOLUMNPROVFIX2, iNewRow).Value = TransactModel.txtFix.Value ' Buy stocks: Update overview for new stocks If TransactModel.Step = SBDIALOGBUY Then iStockRow = GetStockRowIndex(CellStockName) If iStockRow = -1 Then iNewRow = DuplicateRow(oFirstSheet, "HiddenRow2") oFirstSheet.GetCellByPosition(SBCOLUMNNAME1, iNewRow).String = CellStockName oFirstSheet.GetCellByPosition(SBCOLUMNID1, iNewRow).String = TransactModel.txtStockID.Text iStockRow = GetStockRowIndex(CellStockName) End If ' Sell stocks: Get transaction value, then update Transaction sheet ElseIf TransactModel.Step = SBDIALOGSELL Then Profit = oMovementSheet.GetCellByPosition(SBCOLUMNPROCEEDS2, iNewRow).Value Value = Profit Sold = TransactModel.txtQuantity.Value SelStockName = DlgTransaction.GetControl("lstSellStocks").GetSelectedItem() ' Go to first name If TransactMode = FIFO Then iRow = SBROWFIRSTTRANSACT2 Else iRow = iNewRow-1 End If ' Check that no transaction after split date exists else cancel split Do While Sold > 0 oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow) CellStockName = oNameCell.String If CellStockName = SelStockName Then ' Update transactions: Note quantity sold RestQuantity = oMovementSheet.GetCellByPosition(SBCOLUMNQTYREST2, iRow).Value ' If there still is a rest left ... If RestQuantity > 0 Then If RestQuantity < Sold Then ' Recalculate profit of new transaction Profit = Profit - oMovementSheet.GetCellByPosition(SBCOLUMNPRCREST2, iRow).Value AddValueToCellContent(SBCOLUMNQTYSOLD2, iRow, RestQuantity) PartialValue = RestQuantity / Sold * Value AddValueToCellContent(SBCOLUMNREALPROC2, iRow, PartialValue) Sold = Sold - RestQuantity Value = Value - PartialValue Else ' Recalculate profit of neTransactModel.lstBuyStocks.Textw transaction PartialValue = oMovementSheet.GetCellByPosition(SBCOLUMNPRCREST2, iRow).Value Profit = Profit - PartialValue/RestQuantity * Sold ' Update sold shares cell AddValueToCellContent(SBCOLUMNQTYSOLD2, iRow, Sold) ' Update sales turnover cell AddValueToCellContent(SBCOLUMNREALPROC2, iRow, Value) ' Update variables for rest of transaction Sold = 0 Value = 0 End If End If End If iRow = iRow + TransactMode Loop oMovementSheet.GetCellByPosition(SBCOLUMNREALPROFIT2,iNewRow).Value = Profit iStockRow = GetStockRowIndex(SelStockName) iRestQuantity = oFirstSheet.GetCellbyPosition(SBCOLUMNQUANTITY1, iStockRow).Value ' If iRestQuantity = 0 Then ' If oSheets.HasbyName(SelStockName) Then ' oSheets.RemoveByName(SelStockName) ' End If ' Else ' End If End If InsertCurrentValue(CurRate, iStockRow,TransactDate) ProtectSheets(oSheets) End Sub Sub SelectStockname() Dim iCurRow as Integer Dim CurStockName as String With TransactModel ' Find row with stock name If TransactModel.Step = SBDIALOGBUY Then CurStockName = .lstBuyStocks.Text iCurRow = GetStockRowIndex(CurStockName) .txtQuantity.ValueMax = 10000000 Else CurStockName = DlgTransaction.GetControl("lstSellStocks").GetSelectedItem() iCurRow = GetStockRowIndex(CurStockName) .txtQuantity.Value = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1, iCurRow).Value .txtQuantity.ValueMax = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1, iCurRow).Value .txtRate.Value = oFirstSheet.GetCellbyPosition(SBCOLUMNRATE1, iCurRow).Value End If .txtStockID.Enabled = .Step = SBDIALOGBUY .lblStockID.Enabled = .Step = SBDIALOGBUY ' Default settings for quantity and rate .txtStockID.Text = GetStockID(CurStockName, iCurRow) End With EnableTransactionControls(CurStockName <> "") TransactModel.cmdGoOn.DefaultButton = True End Sub Sub HandleStocks(Mode as Integer, oDialog as Object) Dim DividendPerShare, DividendTotal, RestQuantity, OldValue Dim SelStockName, CellStockName as String Dim oNameCell as Object, oDateCell as Object Dim iRow as Integer Dim oDividendCell as Object Dim Amount Dim OldNumber, NewNumber as Integer Dim NoteText as String Dim TotalStocksCount as Long Dim oModel as Object oDocument.AddActionLock oDialog.EndExecute() oModel = oDialog.Model SelStockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem() Select Case Mode Case HANDLEDIVIDEND Dim bTakeTotal as Boolean ' Update transactions: Enter dividend paid for all Buy transactions not sold completely bTakeTotal = oModel.optTotal.State = 1 If bTakeTotal Then DividendTotal = oModel.txtDividend.Value iRow = GetStockRowIndex(SelStockName) TotalStocksCount = oFirstSheet.GetCellByPosition(SBCOLUMNQUANTITY1,iRow).Value DividendPerShare = DividendTotal/TotalStocksCount Else DividendPerShare = oModel.txtDividend.Value End If Case HANDLESPLIT ' Store entered values in variables OldNumber = oModel.txtOldRate.Value NewNumber = oModel.txtNewRate.Value SplitDate = CDateFromISO(oModel.txtDate.Date) iRow = SBROWFIRSTTRANSACT2 NoteText = cSplit & SplitDate & ", " & oModel.txtOldRate.Value & oModel.lblColon.Label & oModel.txtNewRate.Value Do oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow) CellStockName = oNameCell.String If CellStockName = SelStockName Then oDateCell = oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iRow) If oDateCell.Value >= SplitDate Then MsgBox sMsgWrongExchangeDate, SBMSGOK + SBMSGSTOP, sMsgError Exit Sub End If End If iRow = iRow + 1 Loop Until CellStockName = "" End Select iRow = SBROWFIRSTTRANSACT2 UnprotectSheets(oSheets) Do oNameCell = oMovementSheet.GetCellByPosition(SBCOLUMNNAME2, iRow) CellStockName = oNameCell.String If CellStockName = SelStockName Then Select Case Mode Case HANDLEDIVIDEND RestQuantity = oMovementSheet.GetCellByPosition(SBCOLUMNQTYREST2, iRow).Value If RestQuantity > 0 Then oDividendCell = oMovementSheet.GetCellByPosition(SBCOLUMNDIVIDEND2, iRow) OldValue = oDividendCell.Value oDividendCell.Value = OldValue + RestQuantity * DividendPerShare End If Case HANDLESPLIT oDateCell = oMovementSheet.GetCellByPosition(SBCOLUMNDATE2, iRow) SplitCellValue(oMovementSheet, NewNumber, OldNumber, SBCOLUMNQUANTITY2, iRow, NoteText) SplitCellValue(oMovementSheet, OldNumber, NewNumber, SBCOLUMNRATE2, iRow, "") SplitCellValue(oMovementSheet, NewNumber, OldNumber, SBCOLUMNQTYSOLD2, iRow, "") End Select End If iRow = iRow + 1 Loop Until CellStockName = "" If Mode = HANDLESPLIT Then CalculateChartafterSplit(SelStockName, NewNumber, OldNumber, NoteText, SplitDate) End If oDocument.CalculateAll() ProtectSheets(oSheets) oDocument.RemoveActionLock End Sub Sub CancelStockRate() DlgStockRates.EndExecute() End Sub Sub CancelTransaction() DlgTransaction.EndExecute() End Sub Sub CommitStockRate() Dim CurStep as Integer CurStep = StockRatesModel.Step Select Case CurStep Case 1 ' Check for quantity entered If StockRatesModel.txtDividend.Value = 0 Then MsgBox sMsgNoDividend, SBMSGSTOP+SBMSGSTOP, sMsgError Exit Sub End If HandleStocks(HANDLEDIVIDEND, DlgStockRates) Case 2 HandleStocks(HANDLESPLIT, DlgStockRates) Case 3 InsertCompanyHistory() End Select End Sub Sub EnableTransactionControls(bEnable as Boolean) With TransactModel .lblQuantity.Enabled = bEnable .txtQuantity.Enabled = bEnable .lblRate.Enabled = bEnable .txtRate.Enabled = bEnable .lblDate.Enabled = bEnable .txtDate.Enabled = bEnable .lblCommission.Enabled = bEnable .txtCommission.Enabled = bEnable .lblMinimum.Enabled = bEnable .txtMinimum.Enabled = bEnable .lblFix.Enabled = bEnable .txtFix.Enabled = bEnable If TransactModel.Step = SBDIALOGSELL Then .cmdGoOn.Enabled = Ubound(TransactModel.lstSellStocks.SelectedItems()) > -1 DlgTransaction.GetControl("lstSellStocks").SetFocus() Else .cmdGoOn.Enabled = TransactModel.lstBuyStocks.Text <> "" DlgTransaction.GetControl("lstBuyStocks").SetFocus() End If If bEnable Then TransactModel.cmdGoOn.DefaultButton = True End If End With End Sub Sub SetupTransactionControls(CurStep as Integer) DlgReference = DlgTransaction With TransactModel .txtDate.Date = CDateToISO(Date()) .txtDate.DateMax = CDateToISO(Date()) .txtStockID.Enabled = False .lblStockID.Enabled = False .lblStockID.Label = sCurStockIDLabel .txtRate.CurrencySymbol = sCurCurrency .txtFix.CurrencySymbol = sCurCurrency .Step = CurStep End With DlgTransaction.Title = TransactTitle(CurStep) CellValuetoControl(oBankSheet, TransactModel.txtCommission, "ProvisionPercent") CellValuetoControl(oBankSheet, TransactModel.txtMinimum, "ProvisionMinimum") CellValuetoControl(oBankSheet, TransactModel.txtFix, "ProvisionFix") End Sub Sub AddShortCuttoControl() Dim SelCompany as String Dim iRow, SelIndex as Integer SelIndex = DlgTransaction.GetControl("lstBuyStocks").GetSelectedItemPos() If SelIndex <> -1 Then SelCompany = TransactModel.lstBuyStocks.StringItemList(SelIndex) iRow = GetStockRowIndex(SelCompany) If iRow <> -1 Then TransactModel.txtStockID.Text = oFirstSheet.GetCellByPosition(SBCOLUMNID1,iRow).String TransactModel.txtRate.Value = oFirstSheet.GetCellByPosition(SBCOLUMNRATE1,iRow).Value Else TransactModel.txtStockID.Text = "" TransactModel.txtRate.Value = 0 End If Else TransactModel.txtStockID.Text = "" TransactModel.txtRate.Value = 0 End If End Sub Sub OpenStockRatePage(aEvent) Dim CurStep as Integer Initialize(True) CurStep = aEvent.Source.Model.Tag If FillListbox(DlgStockRates.GetControl("lstStockNames"), StockRatesTitle(CurStep), True) Then StockRatesModel.Step = CurStep ToggleStockRateControls(False, CurStep) InitializeStockRatesControls(CurStep) DlgStockRates.Execute() End If End Sub Sub SelectStockNameForRates() Dim StockName as String StockName = DlgStockRates.GetControl("lstStockNames").GetSelectedItem() If StockName <> "" Then StockRatesModel.txtStockID.Text = GetStockID(StockName) ToggleStockRateControls(True, StockRatesModel.Step) End If StockRatesModel.cmdGoOn.DefaultButton = True End Sub Sub ToggleStockRateControls(bDoEnable as Boolean, CurStep as Integer) With StockRatesModel .lblStockID.Enabled = False .txtStockID.Enabled = False .cmdGoOn.Enabled = Ubound(StockRatesModel.lstStockNames.SelectedItems()) <> -1 Select Case CurStep Case 1 .optPerShare.Enabled = bDoEnable .optTotal.Enabled = bDoEnable .lblDividend.Enabled = bDoEnable .txtDividend.Enabled = bDoEnable Case 2 .lblExchangeRate.Enabled = bDoEnable .lblDate.Enabled = bDoEnable .lblColon.Enabled = bDoEnable .txtOldRate.Enabled = bDoEnable .txtNewRate.Enabled = bDoEnable .txtDate.Enabled = bDoEnable Case 3 .lblStartDate.Enabled = bDoEnable .lblEndDate.Enabled = bDoEnable .txtStartDate.Enabled = bDoEnable .txtEndDate.Enabled = bDoEnable .hlnInterval.Enabled = bDoEnable .optDaily.Enabled = bDoEnable .optWeekly.Enabled = bDoEnable End Select End With End Sub Sub InitializeStockRatesControls(CurStep as Integer) DlgReference = DlgStockRates DlgStockRates.Title = StockRatesTitle(CurStep) With StockRatesModel .txtStockID.Text = "" .lblStockID.Label = sCurStockIDLabel Select Case CurStep Case 1 .txtDividend.Value = 0 .optPerShare.State = 1 .txtDividend.CurrencySymbol = sCurCurrency Case 2 .txtOldRate.Value = 1 .txtNewRate.Value = 1 .txtDate.Date = CDateToISO(Date()) Case 3 .txtStartDate.DateMax = CDateToISO(CDate(Date())-1) .txtEndDate.DateMax = CDateToISO(CDate(Date())-1) .txtStartDate.Date = CDateToISO(CDate(Date())-8) .txtEndDate.Date = CDateToISO(CDate(Date())-1) .optDaily.State = 1 End Select End With End Sub