'================================写在之前的话
抱歉,一直没有时间,所以FlexCell作者给我的几种加载数据集方法的代码一直没有发出来。
同时再次感谢FlexCell作者的厚道。
博客上发代码有点困难。如果有人有兴趣的话可以登录我的邮箱去获取FlexCell作者给我的几种加载数据集的方法。
邮箱地址:getsoft@126.com 密码:tianxingjian_01
为了方便大家记忆，密码就是：天行健_01
再次严重声明：我不是打广告的，如果我是打广告的,我的小鸡鸡被狗啃掉。
'=============================下面是原帖。
FlexCell表格控件是国货，用于报表开发十分方便。上句话不是广告。第二句话是实话。
项目开发过程中总是会遇到将数据集导入到FlexCell中的情况，可惜的是FlexCell的VB版不支持ADO，可惜呀可惜呀。
自己写了个通用模块，压力测试了一下，不太好使，速度奇慢无比，但不会出错。见以下代码块1。
'代码块1
Public Function loadRecord(GD As Grid, rs As ADODB.Recordset, _
intFirstCol As Integer, intadJust As Integer, _
Optional FC As Integer, Optional FR As Integer) As Boolean
'FC 冻结列
'FR 冻结行
Dim FiledCount As Integer
Dim RsCount As Integer
Dim i As Integer
Dim j As Integer
Dim strComand As String
On Error GoTo Emsg
loadRecord = False
FiledCount = rs.Fields.Count '记录集列数
RsCount = rs.RecordCount '记录集行数
With GD '初始化FelxCell格式并加载数据集
.selectionMode = 1 '选择模式为行选择,我习惯这个,各位可以自行修改
For i = 1 To .Rows
.RemoveItem (i) '删除所有内容
Next
.BackColor1 = RGB(231, 235, 247) '初始化奇数行的颜色
.BackColor2 = RGB(239, 243, 255) '初始化偶数行的颜色,
.Cols = FiledCount + 1 '表格列数等于记录集列数+1
.AllowUserResizing = True '设置用户可以改变行宽列宽
.BoldFixedCell = False '返回或设置是否在固定行/列上以粗体画出Selection所对应的单元格的文字
.DisplayFocusRect = False '返回或设置控件在当前活动单元格是否显示一个虚框。
.ExtendLastCol = True '返回或设置是否扩展最后一列的列宽，让表格可以充满控件
.Appearance = Flat '表格绘制风格
.FixedRowColStyle = Flat '固定行/列的样式
.ScrollBarStyle = Flat '滚动条样式
.DefaultFont.Name = "Tahoma" '字体样式
.DefaultFont.Size = 8 '字体大小
.Column(0).Width = intFirstCol '设置第一列宽度
.Cell(0, 0).Text = "" '以上都是初始化整个表格样式的,大家可以自己选择,也可以都用默认样式
For i = 1 To .Cols - 1 '初始化表头
.Cell(0, i).Text = rs.Fields.Item(i - 1).Name '表头内容
.Column(i).Width = intadJust '表头宽度
Next
If rs.EOF Then '如果记录集为空则退出函数
loadRecord = True
Exit Function
End If
'如果不为空加载记录集
.AutoRedraw = False '禁止重绘,这样速度快
.Rows = 1
.Refresh
For i = 1 To RsCount '记录集个数
For j = 1 To FiledCount '记录集列个数
'得到加载内容命令
If j = FiledCount Then
strComand = strComand & rs.Fields(j - 1)
Else
strComand = strComand & rs.Fields(j - 1) & Chr(9)
End If
Next
.AddItem strComand, False '执行加载命令,不重绘
Next i
.AutoRedraw = True
.Refresh
.FrozenCols = FC
.FrozenRows = FR
End With
loadRecord = True
Exit Function
Emsg:
MsgBox Err.Description, vbInformation, "系统提示"
End Function
拿上面的代码到VBGOOD上本来想臭美一下，结果一兄弟马上发了一个速度较快的，压力测试了一下，效率是我的好几倍。不敢独享拿出来吧,见以下代码二，代码二的速度还好，但如果某一记录集的值包含chr(13)也就是回车符则会出现串行问题：
'代码二
Public Sub GetSql(gd As Grid, ResOfGdl As ADODB.Recordset, intFirstCol As Integer, _
Optional FC As Integer, _
Optional FR As Integer)
On Error GoTo ED
Dim I As Integer, Tmp() As String
With gd
.SelectionMode = 1 '选择模式为行选择,我习惯这个,各位可以自行修改
For I = 1 To .Rows
.RemoveItem (I) '删除所有内容
Next
.BackColor1 = RGB(231, 235, 247) '初始化奇数行的颜色
.BackColor2 = RGB(239, 243, 255) '初始化偶数行的颜色,
.Cols = ResOfGdl.RecordCount + 1 '表格列数等于记录集列数+1
.AllowUserResizing = True '设置用户可以改变行宽列宽
.BoldFixedCell = False '返回或设置是否在固定行/列上以粗体画出Selection所对应的单元格的文字
.DisplayFocusRect = False '返回或设置控件在当前活动单元格是否显示一个虚框。
.ExtendLastCol = True '返回或设置是否扩展最后一列的列宽，让表格可以充满控件
.Appearance = Flat '表格绘制风格
.FixedRowColStyle = Flat '固定行/列的样式
.ScrollBarStyle = Flat '滚动条样式
.DefaultFont.Name = "Tahoma" '字体样式
.DefaultFont.Size = 8 '字体大小
.Column(0).Width = intFirstCol '设置第一列宽度
.Cell(0, 0).Text = "" '以上都是初始化整个表格样式的,大家可以自己选择,也可以都用默认样式
.AutoRedraw = False
.Rows = 1
.Rows = 1
.Cols = ResOfGdl.Fields.Count + 1
For I = 0 To ResOfGdl.Fields.Count - 1
.Cell(0, I + 1).Text = ResOfGdl.Fields(I).Name
Next
If ResOfGdl.RecordCount = 0 Then GoTo ED
'========================关键是这一段，原来ADO的数据集还可以这样呀。
Tmp = Split(ResOfGdl.GetString(adClipString), Chr$(13))
For I = 0 To UBound(Tmp) - 1
.AddItem Tmp(I), False
Next
End With
ED:
gd.AutoRedraw = True
gd.Refresh
If Err.Number <> 0 Then MsgBox Err.Description & Err.Number, , Err.Source
End Sub
跟FlexCell的技术支持邮件联系了一下，要了几个速度快，也没有错误的方法，其中虚表方法速度最快。
'==========================================
抱歉,一直没有时间,所以FlexCell作者给我的几种加载数据集方法的代码一直没有发出来。
同时再次感谢FlexCell作者的后道。
博客上发代码有点困难。如果有人有兴趣的话可以登录我的邮箱去获取FlexCell作者给我的几种加载数据集的方法。
