'------------------------------------------------------------------------------------------------------------------------
'函数名：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