一个用记录集填充表格的函数
'------------------------------------------------------------------------------------------------------------------------
'函数名:RsFillFlex2
'功能:用记录集填充表格
'创建日期:2007-8-22
'更新日期:2007-8-22
'注意:从第1列开始填充数据,第0列自动生成一个序号列
'由于多出一个序号列,所以表格的列数比记录集的字段数多1
'---------------------------------------------------------------
Public Function RsFillFlex2(strcaption As String, _
grd As MSFlexGrid, _
rs As adodb.Recordset, _
Optional alignFlag As Integer = 0, _
Optional showZeroFlag As Integer = 0, _
Optional Rows_Fixed As Integer = 1, _
Optional TableHead As Integer = 1) As Boolean
'本函数特别要求,对于含的小数点的数值型数据,要根据数据表中的结构显示小数点个数
'功能:将记录添充到表格中
'参数一:表头格式
'参数二:表格控件名称
'参数三:记录集
'参数四:表示是否指定"列对齐方式",为1根据记录集的字段类型来设置,为0根据表格的formatstring设置
'参数五:是否显示数字0,为0不显示,为1要显示
'参数六:固定行数,默认为1
'参数七:表头所占的行数,默认为1 (该参数有何意义?)
'好象记录集必须是客户端游标才行,服务器端游标记录数不好取
Dim i As Long, j As Long, strField As String 'strField用于存放字段内容
Dim vnttmp As Variant '临时存放每个单元格内容[要能存放各种类型数据,故为variant型]
Dim rsCols As Long '记录集的字段数
Dim grdCols As Long '表格的列数
on Error GoTo errhandler
'记录集未打开,则返回错误
If rs.State <> adStateOpen Then
MsgBox "没有可供显示的记录集!", 32, "提示"
RsFillFlex2 = False
Exit Function
End If
'首先判断记录集是否有内容[如果无内容要清除表格原有内容],因为记录集正常打开的情况下,也可能一条记录都没有
If rs.BOF = True And rs.eof = True Then
grd.Rows = grd.FixedRows '清除除表头的所有内容
grd.Rows = Rows_Fixed + 1 '无记录时,显示一个空白行
RsFillFlex2 = True
Exit Function
End If
'注意:不能设置固定行,否则会报错[设置固定行时,除非固定行比行数小一,否则报错]
'以下代码运行的前提是:已有记录
With grd
.Rows = .FixedRows '将行数设置成固定行的行数
.Clear '清除原有内容[重要]
.FormatString = strcaption '格式化表头,确定列数
grdCols = .Cols '取表格列数
rsCols = rs.Fields.Count '记录集字段数
'判断传来的表头与记录集的字段数是否一致
If grdCols <> rsCols + 1 Then
' MsgBox grdcols
' MsgBox rscols
MsgBox "记录集字段数与表格列数不匹配,表格列数应比记录集列数多1,第0列为序号列!", 16, "提示"
RsFillFlex2 = False
Exit Function
End If
'下面进行表格填充[只有在真正填充之前,才能设置成不重绘,否则容易花屏]
.Redraw = False '不重绘,目的是提高速度
'确定表格总行数[因为存在表头,故表数行数应等于记录条数加一]
.Rows = rs.RecordCount + TableHead '该设定决定表格有多少行显示数据,很重要
'根据参数决定是否设置各列对齐方式,为1时不按formatstring设置,按记录集字段类型设置
If alignFlag = 1 Then
For j = 1 To rs.Fields.Count
Select Case rs.Fields(j - 1).Type
Case adDecimal, adDouble, adSingle, adNumeric, adBigInt, adInteger, adTinyInt, adSmallInt
'设定为右对齐
.ColAlignment(j) = 7
Case Else
'设定为左对齐
.ColAlignment(j) = 1
End Select
Next
End If
rs.MoveFirst
For i = 1 To rs.RecordCount '循环显示记录,有多少条记录则循环多少次
.TextMatrix(i, 0) = i '第0列显示序号
For j = 1 To rs.Fields.Count '循环处理各个列
'取单元格的值
vnttmp = Trim(rs.Fields(j - 1).Value & "")
'根据不同的类型,设置不同的格式显示
Select Case rs.Fields(j - 1).Type
Case adDecimal, adDouble, adSingle, adNumeric
If Val(vnttmp) = 0 Then
If showZeroFlag = 0 Then
strField = ""
Else
'根据数据库中的字段小数位数的定义设置格式[注意:要对小数位数为0进行处理]
Select Case rs.Fields(j - 1).NumericScale
Case 0
strField = Format(vnttmp, "#")
Case 1
strField = Format(vnttmp, "#0.0")
Case 2
strField = Format(vnttmp, "#0.00")
Case 3
strField = Format(vnttmp, "#0.000")
Case Else
strField = Format(vnttmp, "#0.000#")
End Select
End If
Else
'根据数据库中的字段小数位数的定义设置格式[注意:要对小数位数为0进行处理]
Select Case rs.Fields(j - 1).NumericScale
Case 0
strField = Format(vnttmp, "#")
Case 1
strField = Format(vnttmp, "#0.0")
Case 2
strField = Format(vnttmp, "#0.00")
Case 3
strField = Format(vnttmp, "#0.000")
Case Else
strField = Format(vnttmp, "#0.000#")
End Select
End If
Case adBigInt, adInteger, adTinyInt, adSmallInt
If Val(vnttmp) = 0 Then
If showZeroFlag = 0 Then
strField = ""
Else
strField = vnttmp
End If
Else
strField = vnttmp
End If
' Case adBoolean
' '布尔值
' strField = IIf(vnttmp = True, "是", "否")
' Case adDBTimeStamp
' '日期时间值
' strField = Left(Format(vnttmp, "yyyy/mm/dd"), 10)
Case Else
strField = vnttmp
End Select
.TextMatrix(i, j) = strField
Next
rs.MoveNext '显示下一条记录
Next
'设定第几行显示在最前面(用toprow属性)
.TopRow = Rows_Fixed
' '使表头各列居中
' .Row = 0
' For j = 0 To .Cols - 1
' '.FixedAlignment(j) = 4
' .Col = j
' .CellAlignment = 4
' Next
.Redraw = True '填完数据后,充许重绘
RsFillFlex2 = True '返回true
End With
Exit Function
errhandler:
grd.Clear
grd.Rows = grd.FixedRows '清除除表头的所有内容
grd.Rows = Rows_Fixed + 1 '无记录时,显示一个空白行
grd.Redraw = True '出错后如果不设置成充许重绘,则会花屏
RsFillFlex2 = False
MsgBox "发生错误:" & Err.Description
End Function
原帖及讨论:http://bbs.bccn.net/thread-164547-1-1.html