您的位置：程序门 -> vb -> 数据库（包含打印，安装，报表)

请问为什么我的datagrid导出excel只有一列

[收藏此页] [打印本页]选择字色：背景色：字体：[大][中][小]

请问为什么我的datagrid导出excel只有一列[已结贴,结贴人:aruima]

发表于：2007-04-16 14:39:05 楼主

我想把显示在datagrid 的数据导出至excel
可是不知道什么原因导出的时候只有一列是第一列而且有两个excel表
请问我错在那里了代码如下
set xlapp = createobject（ "excel.application ")
set xlbook = xlapp.workbooks.add
set xlsheet = xlbook.worksheets（1)
xlapp.visible = true
on error resume next
if err.number <> 0 then set xlapp = createobject（ "excel.application ")
set xlbook = xlapp.workbooks.add
set xlsheet = xlbook.activesheet

for k = 1 to dgrecord.columns.count
xlsheet.cells（1, k) = dgrecord.columns（k - 1).caption
next k
for i = 1 to rsqrecord.recordcount + 1
for j = 0 to dgrecord.columns.count
xlsheet.cells（i + 1, j + 1) = rsqrecord（j)
xlsheet.cells（i + 1, j + 1) = dgrecord.columns（j).celltext（dgrecord.rowbookmark（j))
next j
rsqrecord.movenext
next i

发表于：2007-04-16 15:17:191楼得分:0

没见过，帮你顶！！！

发表于：2007-04-16 15:27:512楼得分:0

不要循环了,
直接这样:
xlsheet.cells.copyfromrecordset rsqrecord

xlsheet.rows（1).insert

for k = 1 to dgrecord.columns.count
xlsheet.cells（1, k) = dgrecord.columns（k - 1).caption
next k

发表于：2007-04-16 15:33:213楼得分:0

我加上了你的代码
可是只显示标题
没有数据

发表于：2007-04-16 15:45:224楼得分:0

那就是你的 rsqrecord没有数据

发表于：2007-04-16 15:51:035楼得分:0

我在查询的时候有数据是不是我的记录集有问题啊

发表于：2007-04-16 15:58:066楼得分:0

我所有的代码包括查询那部分的
option explicit
dim strsql as string
dim i, j, k as integer
dim xlapp as variant
dim xlbook as variant
dim xlsheet as variant

private sub cmnexcel_click（)
set xlapp = createobject（ "excel.application ")
set xlbook = xlapp.workbooks.add
set xlsheet = xlbook.worksheets（1)
xlapp.visible = true
on error resume next
if err.number <> 0 then set xlapp = createobject（ "excel.application ")
set xlbook = xlapp.workbooks.add
set xlsheet = xlbook.activesheet

xlsheet.cells.copyfromrecordset rsqrecord

xlsheet.rows（1).insert

for k = 1 to dgrecord.columns.count
xlsheet.cells（1, k) = dgrecord.columns（k - 1).caption
next k

end sub

private sub cmnquery_click（)

strsql = "select * from bgsb where " '//给定义好的字符变量赋予sql语句 "
'//判断单选框中时,判断办公设备单位单选框选中时
if optdanwei.value = true then
if trim（txbgdanwei.text) = " " then
msgbox "请输入查询的单位 ", vbexclamation + vbokonly, "查询失败 "

exit sub
end if
strsql = strsql & " 单位 = ' " & trim（txbgdanwei.text) & " ' "
' //判断消防名称单选框选中时
elseif optname = true then
if trim（txbgname.text) = " " then
msgbox "请输入的办公设备名称 ", vbexclamation + vbokonly, "查询失败 "

exit sub
end if
strsql = strsql & " 名称 = ' " & trim（txbgname.text) & " ' "

else
msgbox "请选择一个查询条件 ", vbexclamation + vbokonly, "查询失败 "

exit sub
end if

'//当单选框选中时
if rsqbgong.state = adstateclosed then
rsqbgong.open "bgsb ", dbcon, adopenkeyset, adlockoptimistic, adcmdtable
end if
if rsqbgong.state = adstateopen then
rsqbgong.close
end if

if rsqbgong.state = adstateclosed then '//执行strsql中的
rsqbgong.open strsql, dbcon, adopenkeyset, adlockoptimistic, adcmdtext

dgrecord.refresh '//刷新网格
set dgrecord.datasource = rsqbgong.datasource
lblcount.caption = rsqbgong.recordcount '//将记录条数显示在标签上

txbgdanwei.text = empty '//请空文本框
txbgname.text = empty

end if

end sub

private sub cmnreturn_click（)
unload me

end sub

private sub form_load（)
if rsqbgong.state = adstateopen then
rsqbgong.close
end if
rsqbgong.open "bgsb ", dbcon, adopenkeyset, adlockpessimistic, adcmdtable

if rsqbgong.recordcount > 0 then '//如果记录集中有记录
set dgrecord.datasource = rsqbgong.datasource '//设置网格的数据源
end if
lblcount.caption = rsqbgong.recordcount
end sub

发表于：2007-04-16 16:05:277楼得分:0

靠,上面写着rsqrecord,下面怎么都是rsqbgong啊,怎么是两个个记录集

xlsheet.cells.copyfromrecordset rsqrecord '--这个改成你要导出数据的纪录集,就是和网格绑定的那个

发表于：2007-04-16 16:24:188楼得分:0

结果出来了但是有两个excel表
一个空的一个有数据关闭其中的一个两个都关闭了

发表于：2007-04-16 16:26:279楼得分:1

支持楼上
并且set xlbook = xlapp.workbooks.add
set xlsheet = xlbook.worksheets（1)
xlapp.visible = true
on error resume next
if err.number <> 0 then set xlapp = createobject（ "excel.application ")
set xlbook = xlapp.workbooks.add
set xlsheet = xlbook.activesheet
这里好象有问题或许是你出现两个excel表的原因???

发表于：2007-04-16 16:52:5710楼得分:0

怎么修改啊

发表于：2007-04-16 16:59:0011楼得分:0

改过来了

发表于：2007-04-16 16:59:5512楼得分:9

private sub cmnexcel_click（)
set xlapp = createobject（ "excel.application ")
set xlbook = xlapp.workbooks.add
set xlsheet = xlbook.worksheets（1)

on error resume next
if err.number <> 0 then set xlapp = createobject（ "excel.application ")
set xlbook = xlapp.workbooks.add
set xlsheet = xlbook.worksheets（ "sheet1 ")

xlsheet.cells.copyfromrecordset rsqrecord

xlsheet.rows（1).insert

for k = 1 to dgrecord.columns.count
xlsheet.cells（1, k) = dgrecord.columns（k - 1).caption
next k

xlapp.visible = true

end sub

发表于：2007-05-29 11:18:0013楼得分:0

aruima（) 你好！
我也在做datagrid导出excel表的功能，我碰到的问题也是两个excel表，
且只显示标题没有数据

能否将你改好的private sub cmnexcel_click（)代码
传上来看看啊，谢谢！

发表于：2007-05-31 14:42:0714楼得分:0

能否分享一下新代码呢？

下一篇：使用getobject打开excel文件时，提示类型不匹配？（在线等）
上一篇：打包程序报错，运行时错误 "76 ":未找到路径

其他资讯

您的位置：程序门 -> vb -> 数据库（包含打印，安装，报表)

请问 为什么我的datagrid导出excel只有一列

请问为什么我的datagrid导出excel只有一列