<pss_extension min_pss_version="7.1" name="Capital Gains Report" version="1.0.0">Extended Capital Gains Report
<author email="support@dtlink.com" name="DTLink Software" url="http://www.dtlink.com" />
<script language="VBScript">
<![CDATA[
' Capital gains report for Personal Stock Streamer
' Copyright © 2005 by DTLink Software, All rights reserved.
' http://www.dtlink.com
' written by Anatoly Ivasyuk
' ================================================
' define a class to record all of the items affecting gains
class CapGainsInfo
Dim szSymbol
Dim szName
Dim dtAcquired
Dim dtSold
Dim fNumShares
Dim fTotalPrice
Dim fTotalBasis
Dim fGain
Dim szComment
end class
' ================================================
' define the report handler class
class CapGainsReportHandler
' create the report
public Function GenerateReport ( Name, Handler, Folder )
'Application.DebugTrace "CapGainsReportHandler::GenerateReport(" + Name + ")"
' initialize the report arrays
ReDim aLongTerm(0)
ReDim aShortTerm(0)
ReDim aOther(0)
' generate the report summary data
Set objHandler = Handler
RecurseFolder Handler, Folder, True
Set objHandler = Nothing
' generate report header
Handler.WriteReport "<body bgcolor=White>"
Handler.WriteReport "<b>Capital Gains Report for " + Handler.FilterPeriod + "</b>"
' short term report
Handler.WriteReport "<p><u><b>Short-term capital gains and losses</b></u>"
Handler.WriteReport "<table border=0 cellpadding=0 cellspacing=10>"
Handler.WriteReport "<tr><th><b>Shares</b></th><th><b>Description</b></th><th><b>Acquired</b></th><th><b>Sold</b></th><th><b>Price</b></th><th><b>Cost</b></th><th><b>Gain</b></th><th><b>Comment</b></th></tr>"
WriteReportSection Handler, aShortTerm
Handler.WriteReport "</table>"
' long term report
Handler.WriteReport "<p><u><b>Long-term capital gains and losses</b></u>"
Handler.WriteReport "<table border=0 cellpadding=0 cellspacing=10>"
Handler.WriteReport "<tr><th><b>Shares</b></th><th><b>Description</b></th><th><b>Acquired</b></th><th><b>Sold</b></th><th><b>Price</b></th><th><b>Cost</b></th><th><b>Gain</b></th><th><b>Comment</b></th></tr>"
WriteReportSection Handler, aLongTerm
' dividend, income, and expenses report
Handler.WriteReport "<p><u><b>Other income and expenses</b></u>"
Handler.WriteReport "<table border=0 cellpadding=0 cellspacing=10>"
Handler.WriteReport "<tr><th><b></b></th><th><b>Description</b></th><th><b>Date</b></th><th><b></b></th><th><b></b></th><th><b></b></th><th><b>Gain</b></th><th><b>Comment</b></th></tr>"
WriteReportSection Handler, aOther
Handler.WriteReport "</table>"
Handler.WriteReport "</body>"
end Function
' write an array out as a series of formatted rows and calculate the total gain for this section
public Function WriteReportSection ( Handler, arr )
Dim TotalGain
TotalGain = 0
Sort arr
For i = 0 to GetArraySize(arr) - 1
If (arr(i).fNumShares = 0) Then
Handler.WriteReport "<tr><td align=right></td><td>" + arr(i).szSymbol + " -- " + arr(i).szName + "</td>" + _
"<td>" + FormatDateTime(arr(i).dtAcquired, vbShortDate) + "</td><td></td>" + _
"<td align=right></td><td align=right></td>" + _
"<td align=right>" + FormatNumber(arr(i).fGain, 2) + "</td><td>" + arr(i).szComment + "</td></tr>"
Else
Handler.WriteReport "<tr><td align=right>" + CStr(arr(i).fNumShares) + "</td><td>" + arr(i).szSymbol + " -- " + arr(i).szName + "</td>" + _
"<td>" + FormatDateTime(arr(i).dtAcquired, vbShortDate) + "</td><td>" + FormatDateTime(arr(i).dtSold, vbShortDate) + "</td>" + _
"<td align=right>" + FormatNumber(arr(i).fTotalPrice, 2) + "</td><td align=right>" + FormatNumber(arr(i).fTotalBasis, 2) + "</td>" + _
"<td align=right>" + FormatNumber(arr(i).fGain, 2) + "</td><td>" + arr(i).szComment + "</td></tr>"
End If
TotalGain = TotalGain + arr(i).fGain
Next
Handler.WriteReport "<tr><td></td><td>Total</td><td></td><td></td><td></td><td></td>" + _
"<td align=right>" + FormatNumber(TotalGain, 2) + "</td><td></td></tr>"
end Function
' recurse through a folder and run a summary on each of the tickers
public Function RecurseFolder ( Handler, Folder, ShortTerm )
Dim i, Tickers
' process the tickers in the folder
Set Tickers = Folder.Tickers
'Application.DebugTrace "CapGainsReportHandler::RecurseFolder() Tickers.Count = " + CStr(Tickers.Count)
For i = 1 To Tickers.Count
' Application.DebugTrace "CapGainsReportHandler::RecurseFolder() ticker=" + Tickers.Item(i).GetProperty("Symbol") + " active=" + CStr(Tickers.Item(i).GetProperty("Active"))
Tickers.Item(i).ApplyTransactionsToCurrentHoldingsUntil Now, me
Next
' recursively loop through the subfolders
Set Folders = Folder.Folders
For i = 1 To Folders.Count
RecurseFolder Handler, Folders.Item(i), ShortTerm
Next
end Function
' callback functions
public Function OnCBAddHoldings ( LotInfo, Transaction, Shares )
Dim obj
'Application.DebugTrace "CapGainsReportHandler::OnCBAddHoldings()"
If Not objHandler.IsTransactionInReport(Transaction) Or LotInfo.GetProperty("Shares") >= 0 Then
Exit Function
End If
Set obj = new CapGainsInfo
obj.szSymbol = Transaction.GetProperty("Symbol")
obj.szName = Transaction.GetProperty("Name")
obj.fNumShares = Abs(Shares)
obj.dtAcquired = Transaction.GetProperty("Date")
obj.dtSold = LotInfo.GetProperty("Date")
If (LotInfo.GetProperty("Shares") <> 0) Then
obj.fTotalPrice = obj.fNumShares * LotInfo.GetProperty("Price") - (obj.fNumShares / Abs(LotInfo.GetProperty("Shares"))) * LotInfo.GetProperty("Commission")
Else
obj.fTotalPrice = 0
End If
If (Transaction.GetProperty("Shares") <> 0) Then
obj.fTotalBasis = obj.fNumShares * Transaction.GetProperty("Price") + obj.fNumShares / Transaction.GetProperty("Shares") * Transaction.GetProperty("Commission")
Else
obj.fTotalBasis = 0
End If
obj.fGain = obj.fTotalPrice - obj.fTotalBasis
obj.szComment = "(Short)"
' add it to the correct array
AddObjectToAppropriateArray obj, LotInfo, Transaction
end Function
public Function OnCBSubtractHoldings ( LotInfo, Transaction, Shares )
Dim obj
'Application.DebugTrace "CapGainsReportHandler::OnCBSubtractHoldings()"
If Not objHandler.IsTransactionInReport(Transaction) Or LotInfo.GetProperty("Shares") <= 0 Then
Exit Function
End If
Set obj = new CapGainsInfo
obj.szSymbol = Transaction.GetProperty("Symbol")
obj.szName = Transaction.GetProperty("Name")
obj.fNumShares = Shares
obj.dtAcquired = LotInfo.GetProperty("Date")
obj.dtSold = Transaction.GetProperty("Date")
If (Transaction.GetProperty("Shares") <> 0) Then
obj.fTotalPrice = obj.fNumShares * Transaction.GetProperty("Price") - (obj.fNumShares / Transaction.GetProperty("Shares")) * Transaction.GetProperty("Commission")
Else
obj.fTotalPrice = 0
End If
If (LotInfo.GetProperty("Shares") <> 0) Then
obj.fTotalBasis = obj.fNumShares * LotInfo.GetProperty("Price") + (obj.fNumShares / LotInfo.GetProperty("Shares")) * LotInfo.GetProperty("Commission")
Else
obj.fTotalBasis = 0
End If
If (Transaction.GetProperty("Type") = "SharesOut") Then
obj.fGain = 0
obj.szComment = "(Transfer Out)"
Else
obj.fGain = obj.fTotalPrice - obj.fTotalBasis
End If
' add it to the correct array
AddObjectToAppropriateArray obj, LotInfo, Transaction
end Function
public Function OnCBAddIncome ( Transaction )
Dim t, obj
If Not objHandler.IsTransactionInReport(Transaction) Then
Exit Function
End If
t = Transaction.GetProperty("Type")
If (t = "Dividend" Or t = "Interest" or t = "Misc Income") Then
Set obj = new CapGainsInfo
obj.szSymbol = Transaction.GetProperty("Symbol")
obj.szName = Transaction.GetProperty("Name")
obj.fNumShares = 0
obj.dtAcquired = Transaction.GetProperty("Date")
obj.fGain = Transaction.GetProperty("Price")
obj.szComment = t
ReDim Preserve aOther(GetArraySize(aOther) + 1)
Set aOther(GetArraySize(aOther) - 1) = obj
End If
end Function
public Function OnCBSubtractIncome ( Transaction )
Dim t, obj
If Not objHandler.IsTransactionInReport(Transaction) Then
Exit Function
End If
t = Transaction.GetProperty("Type")
If (t = "Margin Int" Or t = "Misc Expense") Then
Set obj = new CapGainsInfo
obj.szSymbol = Transaction.GetProperty("Symbol")
obj.szName = Transaction.GetProperty("Name")
obj.fNumShares = 0
obj.dtAcquired = Transaction.GetProperty("Date")
obj.fGain = Transaction.GetProperty("Price") * -1
obj.szComment = t
ReDim Preserve aOther(GetArraySize(aOther) + 1)
Set aOther(GetArraySize(aOther) - 1) = obj
End If
end Function
' add the given object to the long term or short term array depending on the dates given
public Function AddObjectToAppropriateArray( obj, LotInfo, Transaction)
Dim days
days = Abs( DateDiff( "d", LotInfo.GetProperty("Date"), Transaction.GetProperty("Date") ) )
If (days < 365) Then
ReDim Preserve aShortTerm(GetArraySize(aShortTerm) + 1)
Set aShortTerm(GetArraySize(aShortTerm) - 1) = obj
Else
ReDim Preserve aLongTerm(GetArraySize(aLongTerm) + 1)
Set aLongTerm(GetArraySize(aLongTerm) - 1) = obj
End If
end Function
' get the array size and ignore errors for unininitialized array
public Function GetArraySize( array )
Dim size
size = 0
On Error Resume Next
size = UBound(array)
On Error Goto 0
GetArraySize = size
end Function
' sort the array by ticker (slow bubble sort algorithm)
public Sub Sort( arr() )
Dim i, j, temp
For i = GetArraySize(arr) - 1 To 0 Step -1
For j = 1 to i
If arr(j - 1).szSymbol > arr(j).szSymbol Then
Set temp = arr(j-1)
Set arr(j-1) = arr(j)
Set arr(j) = temp
End If
Next
Next
end Sub
' local storage
Dim objHandler
Dim aShortTerm()
Dim aLongTerm()
Dim aOther()
end Class
' ================================================
' register the custom report with the application
Dim ReportHandler
Set ReportHandler = new CapGainsReportHandler
Dim ReportManager
Set ReportManager = Application.GetObject("ReportManager")
If Not ReportManager Is Nothing Then
ReportManager.Register "Capital Gains (Extended)", ReportHandler
Else
Application.LogError "Error", "Capital Gains Report", "Could not get ReportManager object"
End If
]]>
</script>
</pss_extension>
