VB老头

-----------------------------------------------------------------------------------------------------------
'说明：转载自枕善居
'函数名：RsFillFlex2
'功能：用记录集填充表格
'创建日期：2007-8-22
'更新日期：2007-8-22
'作者：ggyy66
'注意：从第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