Option Explicit
Private m_GroupBy, m_SumOn, m_OmitZero As String
Private m_TotalCaption As Long
Private TotalFields As Long
Private m_isAppend As Boolean
Property Get FieldGroupBy() As String
FieldGroupBy = m_GroupBy
End Property
Property Let FieldGroupBy(ByVal newGroupBy As String)
m_GroupBy = newGroupBy
End Property
Property Get SumOnField() As String
SumOnField = m_SumOn
End Property
Property Let SumOnField(ByVal newSumOn As String)
m_SumOn = newSumOn
End Property
Property Get ColoumnNameToSkipRecordIfZero() As String
ColoumnNameToSkipRecordIfZero = m_OmitZero
End Property
Property Let ColoumnNameToSkipRecordIfZero(ByVal newOmitZero As String)
m_OmitZero = newOmitZero
End Property
Property Get TotalCaptionAtColumnNumber() As Long
TotalCaptionAtColumnNumber = m_TotalCaption
End Property
Property Let TotalCaptionAtColumnNumber(ByVal newTotalCaption As Long)
m_TotalCaption = newTotalCaption
End Property
Property Get isAppend() As Boolean
isAppend = m_isAppend
End Property
Property Let isAppend(ByVal newIsAppend As Boolean)
m_isAppend = newIsAppend
End Property
Public Sub AddinGrid(pRsName As ADODB.Recordset, FlexGrid As MSFlexGrid, Optional CloseCursor As Boolean)
If pRsName.EOF = True Or pRsName.BOF = True Then
MsgBox "Recordset either EOF or BOF"
pRsName.Close
Exit Sub
End If
If pRsName.RecordCount >= 5555 Then
MsgBox "Too bit table to fit in FlexGrid"
pRsName.Close
Exit Sub
End If
FlexGrid.AllowUserResizing = flexResizeColumns
Dim i, NewRow, FieldNumber, gFieldNumber As Long
Dim yesGroupFound As Boolean
Dim yesSumFound As Boolean
Dim yesOmitFound As Boolean
Dim LastFieldValue As Variant
Dim mTotal As Variant
Dim RecordSkip As Boolean
TotalFields = pRsName.Fields.Count
If m_GroupBy <> "" Then
For i = 0 To TotalFields - 1
If UCase(pRsName.Fields(i).Name) = UCase(m_GroupBy) Then
yesGroupFound = True
gFieldNumber = i
Exit For
End If
Next i
If yesGroupFound = False Then
MsgBox "Invalid field entered for grouping"
Exit Sub
End If
End If
If m_SumOn <> "" Then
For i = 0 To TotalFields - 1
If UCase(pRsName.Fields(i).Name) = UCase(m_SumOn) And (pRsName.Fields(i).Type = adDouble _
Or pRsName.Fields(i).Type = adNumeric _
Or pRsName.Fields(i).Type = adLongVarChar) Then
yesSumFound = True
FieldNumber = i
Exit For
End If
Next i
If yesSumFound = False Then
MsgBox "Field entered for sum invalid or non numeric."
Exit Sub
End If
End If
If m_OmitZero <> "" Then
For i = 0 To TotalFields - 1
If UCase(pRsName.Fields(i).Name) = UCase(m_OmitZero) And (pRsName.Fields(i).Type = adDouble _
Or pRsName.Fields(i).Type = adNumeric _
Or pRsName.Fields(i).Type = adLongVarChar) Then
yesOmitFound = True
Exit For
End If
Next i
If yesOmitFound = False Then
MsgBox "Field entered for Omit zero value is invalid or non numeric."
Exit Sub
End If
End If
i = 0
FlexGrid.Cols = TotalFields
If m_isAppend = False Then
FlexGrid.Rows = 2
End If
FlexGrid.RowHeight(0) = 400
With FlexGrid
For i = 0 To TotalFields - 1
If Not IsNull(pRsName.Fields(i)) Then
.CellFontBold = True
.TextMatrix(0, i) = UCase(pRsName.Fields(i).Name)
End If
Next i
i = 0
pRsName.MoveFirst
If m_GroupBy <> "" Then
LastFieldValue = pRsName.Fields("" & m_GroupBy & "")
End If
If m_isAppend = False Then
NewRow = 0
End If
Do While pRsName.EOF = False
If m_OmitZero <> "" Then
If pRsName.Fields("" & m_OmitZero & "") = 0 Then
RecordSkip = True
Else
RecordSkip = False
End If
End If
If RecordSkip = False Then
If m_SumOn <> "" And m_GroupBy = "" Then
mTotal = mTotal + pRsName.Fields("" & m_SumOn & "")
End If
If m_GroupBy <> "" Then
If LastFieldValue = pRsName.Fields("" & m_GroupBy & "").Value Then
If m_SumOn <> "" Then
mTotal = mTotal + pRsName.Fields("" & m_SumOn & "")
End If
Else
If NewRow > 1 Then
.Rows = .Rows + 1
NewRow = .Rows - 1
If m_SumOn <> "" Then
If m_TotalCaption > 0 Then
.TextMatrix(NewRow, m_TotalCaption) = "Total"
.Col = m_TotalCaption
.Row = .Rows - 1
.CellFontUnderline = True
.CellFontBold = True
.CellBackColor = vbWhite
.CellForeColor = vbMagenta
Else
.TextMatrix(NewRow, 1) = "Total"
End If
.TextMatrix(NewRow, FieldNumber) = Format(Round(mTotal, 0), "#######.00")
mTotal = 0
mTotal = mTotal + pRsName.Fields("" & m_SumOn & "")
End If
.Col = gFieldNumber
.Row = .Rows - 1
.CellBackColor = vbWhite
.Col = TotalFields - 1
'.Cols = TotalFields
.Row = .Rows - 1
.ColSel = FieldNumber
.FillStyle = flexFillRepeat
.CellBackColor = vbWhite
.CellForeColor = vbBlue
.CellFontBold = True
End If
End If
End If
End If
If RecordSkip = False Then
.Rows = .Rows + 1
NewRow = .Rows - 1
For i = 0 To TotalFields - 1
If Not IsNull(pRsName.Fields(i)) Then
If pRsName.Fields(i).Type = adDouble Then
.TextMatrix(NewRow, i) = Format(pRsName.Fields(i).Value, "#######.00")
Else
.TextMatrix(NewRow, i) = pRsName.Fields(i).Value
End If
Else
.TextMatrix(NewRow, i) = ""
End If
Next i
i = 0
If m_GroupBy <> "" Then
LastFieldValue = pRsName.Fields("" & m_GroupBy & "")
End If
End If
pRsName.MoveNext
Loop
If mTotal > 0 And m_GroupBy = "" And m_SumOn <> "" Then
.Rows = .Rows + 1
NewRow = .Rows - 1
If m_TotalCaption > 0 Then
.TextMatrix(NewRow, m_TotalCaption) = "Total"
Else
.TextMatrix(NewRow, 1) = "Total"
End If
.TextMatrix(NewRow, FieldNumber) = Format(Round(mTotal, 0), "#######.00")
mTotal = 0
.Col = TotalFields - 1
.Row = .Rows - 1
.ColSel = FieldNumber
.FillStyle = flexFillRepeat
.CellBackColor = vbWhite
.CellForeColor = vbBlue
.CellFontBold = True
End If
If CloseCursor = True Then
pRsName.Close
Set pRsName = Nothing
End If
End With
End Sub