miaozk2006

点滴积累与收藏:关于技术，关于生活

日志

关于我

miaozk2006

文章分类

VB用记录集填充表格函数

2012-03-29 10:29:26| 分类：编程-VB | 标签： |举报 |字号大中小订阅

下载LOFTER 我的照片书 |

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

相关文章参考：

※vb用数组方式快速导出MSFlexGrid表格数据到Excel表格中

※VB表格控件总览与例程分析

※VB用记录集填充表格函数

※VB为MSHFlexGrid添加表格编辑功能

★
VB部分相关文章推荐：★

※vb中line的用法[转]

※画图工具的VB实现

※VB 一个获得自己外网 IP 地址的程序代码

※VB程序中实现IP地址子网掩码网关DNS的更改 [转]

※在 VB 中应用 FSO 对象模型介绍（摘自网络）

※[转] Vb中FSO 对象的介绍

※VB 画坐标轴

※VB 二进制文件的操作

※[VB]BMP转JPG VB中KeyCode常数用法

※vb实时曲线的绘制和保存

※VB操作EXCEL

※vb初学回顾：最大公约数　最小公倍数　素数求取

※vb 关于窗口样式的API以及处理文本的API参考

※【引用】在VB6.0中实现弹出式菜单的几种方法

※【引用】URLDownloadToFile_VB下载文件!

※[转]VB:如何检测到U盘的插拔(源代码)

※巧用SendMessage函数扩展Treeview功能

※vb中如何在任务管理器里面隐藏应用程序进程

※如何实现VB与EXCEL的无缝连接

※一个API方式存取日志文件的模块[VB]

※VB用记录集填充表格函数

※VB打开文本文件各种方法

※vb ClipBoard 剪切板应用（复制剪切粘贴）

※【引用】窗口处理技巧大全 vb(窗体控件)

※【转】 Md rd命令之VB

※vb：读写文本文件

※在vb中实现真正锁定的带自定义菜单的文本控件

※【引用】使用CommonDialog的ShowSave后如何判断是保存还是※取消？

※vb 关于commondialog的多选 VB获取Windows操作系统所有版本

※vb UTF文本文件访问

※VB编程中的Unicode vs Ansi

※VB编PiView4注册机

※VB获取超过2G文件的大小

※比CopyMemory还要快的函数SuperCopyMemory

※VB:编程效率快步提高之:十七种可用一行代码完成的技巧

※VB画出来的五星红旗

※Qt第一印象——Qte与Qt

历史上的今天

this.p={  m:2,
              b:2,
              loftPermalink:'',
              id:'fks_087067092083081064083095082069072085089065080081086070092',
              blogTitle:'VB用记录集填充表格函数',
              blogAbstract:'<SPAN style=\"COLOR: #ff00ff;\"   \>\r\n<DIV style=\"BORDER-BOTTOM: rgb(102,102,102) 1px dashed; BORDER-LEFT: rgb(102,102,102) 1px dashed; PADDING-BOTTOM: 4px; OVERFLOW-X: hidden; OVERFLOW-Y: auto; BACKGROUND-COLOR: rgb(250,250,250); MARGIN: 2px; PADDING-LEFT: 4px; WIDTH: 590px; PADDING-RIGHT: 4px; FONT: 11px Verdana; HEIGHT: 301px; COLOR: rgb(102,102,102); BORDER-TOP: rgb(102,102,102) 1px dashed; BORDER-RIGHT: rgb(102,102,102) 1px dashed; PADDING-TOP: 4px; background-origin: initial; background-clip: initial;\"   id=\"CODE_2505\"  \>\r\n<P\><SPAN style=\"COLOR: #ff00ff;\"   \>\'------------------------------------------------------------------------------------------------------------------------</SPAN\><BR\><SPAN style=\"COLOR: #ff00ff;\"   \>\'函数名：RsFillFlex2</SPAN\><BR\><SPAN style=\"COLOR: #ff00ff;\"   \>\'功能：用记录集填充表格</SPAN\></P\></DIV\></SPAN\>',
              blogTag:'',
              blogUrl:'blog/static/3824705820121233659345',
              isPublished:1,
              istop:false,
              type:2,
              modifyTime:1379662850405,
              publishTime:1332988166865,
              permalink:'blog/static/3824705820121233659345',
              commentCount:0,
              mainCommentCount:0,
              recommendCount:0,
              bsrk:-100,
              publisherId:0,
              recomBlogHome:false,
              currentRecomBlog:false,
              attachmentsFileIds:[],
              vote:{},
              groupInfo:{},
              friendstatus:'none',
              followstatus:'unFollow',
              pubSucc:'',
              visitorProvince:'',
              visitorCity:'',
              visitorNewUser:false,
              postAddInfo:{},
              mset:'000',
              mcon:'',
              srk:-100,
              remindgoodnightblog:false,
              isBlackVisitor:false,
              isShowYodaoAd:false,
              hostIntro:'',
              hmcon:'0',
              selfRecomBlogCount:'0',
              lofter_single:'<iframe width="140" height="560" style="overflow:hidden;" src="http://www.lofter.com/mailEntry.do?blogad=1&blog" frameBorder="0"></iframe>'
            }

{list a as x}
    {if !!x}
    <div class="iblock nbw-fce nbw-f40">
      <a class="fc03 noul" target="_blank" hidefocus="true" href="http://blog.163.com/${x.visitorName}/">
      {if x.visitorName==visitor.userName}
      <img alt="${x.visitorNickname|escape}" onerror="this.src=location.f40" class="cwd bdwa bdc0" src="${fn1(x.visitorName)}&r=${visitor.imageUpdateTime}"/>
      {else}
      <img alt="${x.visitorNickname|escape}" onerror="this.src=location.f40" class="cwd bdwa bdc0" src="${fn1(x.visitorName)}"/>
      {/if}
      </a>
      <div class="cwd vname thide">
        {if x.moveFrom=='wap'}
          <a class="noul pnt" target="_blank" href="http://blog.163.com/services/wapblog.html?frompersonalbloghome"><span title="来自网易手机博客" class="iblock wapIcon"> </span></a>
        {elseif x.moveFrom=='iphone'}
          <a class="noul pnt" target="_blank"><span title="来自iPhone客户端" class="iblock iphoneIcon"> </span></a>
        {elseif x.moveFrom=='android'}
          <a class="noul pnt" target="_blank"><span title="来自Android客户端" class="iblock androidIcon"> </span></a>
        {elseif x.moveFrom=='mobile'}
          <a class="noul pnt" target="_blank" href="http://blog.163.com/services/emsblog.html?frompersonalbloghome"><span title="来自网易短信写博" class="iblock wapIcon"> </span></a>
        {/if}
        <a class="fc03 m2a"  target="_blank" hidefocus="true" href="http://blog.163.com/${x.visitorName}/">
          ${fn(x.visitorNickname,8)|escape}
        </a>
      </div>
    </div>
    {/if}
    {/list}

<#--最新日志，群博日志--> <#--推荐日志-->

<p class="fc06">推荐过这篇日志的人：</p>
    <div>
      {list a as x}
      {if !!x}
      <div class="iblock nbw-fce nbw-f40">
        <a class="fc03 noul" target="_blank" hidefocus="true" href="http://blog.163.com/${x.recommenderName}/">
        <img alt="${x.recommenderNickname|escape}" onerror="this.src=location.f40" class="cwd bdwa bdc0" src="${fn1(x.recommenderName)}"/>
        </a>
        <div class="cwd thide">
          <a class="fc03 m2a" target="_blank" hidefocus="true" href="http://blog.163.com/${x.recommenderName}/">
            ${fn(x.recommenderNickname,6)|escape}
          </a>
        </div>
      </div>
      {/if}
      {/list}
    </div>
    {if !!b&&b.length>0}
    <p  class="fc06">他们还推荐了：</p>
    <ul>
    {list b as y}
      {if !!y}
        <li class="rrb"><span class="iblock">·</span><a class="fc03 m2a" target="_blank" href="http://blog.163.com/${y.recommendBlogPermalink}/?from=blog/static/3824705820121233659345">${y.recommendBlogTitle|escape}</a></li>
      {/if}
    {/list}
    </ul>
    {/if}

<#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇，下一篇--> <#-- 热度 -->

{list a as x}
    {if !!x}
    <div class="hotItem iblock nbw-fce nbw-f40">
      <a class="fc03 noul" target="_blank" hidefocus="true" href="http://blog.163.com/${x.publisherUsername}/">
      {if x.publisherUsername==visitor.userName}
      <img alt="${x.publisherNickname|escape}" onerror="this.src=location.f40" class="cwd bdwa bdc0" src="${fn1(x.publisherUsername)}&r=${visitor.imageUpdateTime}"/>
      {else}
      <img alt="${x.publisherNickname|escape}" onerror="this.src=location.f40" class="cwd bdwa bdc0" src="${fn1(x.publisherUsername)}"/>
      {/if}
      </a>
      <div class="cwd vname thide">
        <a class="fc03 m2a"  target="_blank" hidefocus="true" href="http://blog.163.com/${x.publisherUsername}/">
          ${fn(x.publisherNickname,8)|escape}
        </a>
      </div>
      <a class="f-myLikeIcons hottype {if x.type==1} js-liketype{elseif x.type==2} js-reblogtype{elseif x.type==3} js-sharetype{else}{/if}" target="_blank" hidefocus="true" href="http://blog.163.com/${x.publisherUsername}/"> </a>
    </div>
    {/if}
    {/list}

<#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->

页脚

我的照片书 - 手机博客 - 下载LOFTER APP - 订阅此博客

miaozk2006

导航

日志

VB用记录集填充表格函数

※VB表格控件总览与例程分析

※VB为MSHFlexGrid添加表格编辑功能

历史上的今天

最近读者

热度

评论

页脚