| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1483 人关注过本帖
标题:将数据按班导出到同EXCEL的不同工作表上代码的改进反馈,并求助!
只看楼主 加入收藏
wengjl
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:109
帖 子:2214
专家分:3882
注 册:2007-4-27
结帖率:95.83%
收藏
已结贴  问题点数:10 回复次数:8 
将数据按班导出到同EXCEL的不同工作表上代码的改进反馈,并求助!
**************************************************************************
* 程 序 名:按班导出到EXCEL的不同工作表中.PRG
* 原贴提问:如何把一个学生成绩表,分别按 班级 导出excel中不同的sheet中。
*      比如:把一班的成绩导出到sheet1中,把二班的成绩导出到sheet2中。
* 翁建林于2011年12月16日晚摘自 https://bbs.bccn.net/thread-197786-1-8.html 帖子
*           上Tiger5392的回答,并进行了修改和注释
*           原回答上生成的EXCEL表上没有字段名,经修改后就有了字段名
* 原理理解:数据表的记录排列前提是以班级为序
**************************************************************************
SET SAFETY off
SET ENGI 70
create cursor Student (班级 C(10),学号 C(8),姓名 C(8),性别 C(2))
insert into Student Values ('经济04-1','B0401001','张三','男')
insert into Student Values ('经济04-1','B0401002','李四','男')
insert into Student Values ('经济04-2','B0401003','王五','男')
insert into Student Values ('经济04-2','B0401004','赵六','男')
insert into Student Values ('经济04-3','B0401005','孙启','男')
insert into Student Values ('经济04-3','B0401006','周把','男')
insert into Student Values ('经济05-1','B0501001','乌桕','男')
insert into Student Values ('经济05-1','B0501002','手动','男')
insert into Student Values ('经济05-1','B0501003','风格','男')
insert into Student Values ('经济06-1','B0601001','规划','男')
insert into Student Values ('经济06-1','B0601002','沟通','男')

select * from student order by 班级 into cursor st
select count(*) as amount from student group by 班级 into cursor st1
select st1
lnSheets=reccount('st1')    &&&&这个是记录班级数量
*----------------------------------------------------
*
*此外需加一判断,如果用户的电脑上未装EXCEL软件,则结束运行。   此判断不会写,请高手赐教
*
*----------------------------------------------------
oel=NewObject('Excel.Application')    &&&&这是创建EXCEL对象
oel.workbooks.add    &&&这是增加工作簿
oel.visible=.t.      &&&显示EXCEL对象
DO while oel.workbooks(1).worksheets.count<lnSheets
  oel.workbooks(1).worksheets.add
ENDDO
*--- 通过这个DO while……ENDDO循环增加工作表
*----------------------------------------------------
select st        &&&& 数据表的记录排列前提是以班级为序
lcClass=space(100)  &&&&& 班级名变量
lnCnt=0             &&&&& 工作表计数
lnRow=1             &&&&& 行控制变量
SCAN
  IF lcClass#班级    &&&& 如果变量 lcClass 与字段名变量的内容不相等
    lnCnt=lnCnt+1    &&& 用于控制EXCEL中的第几张表
    lnRow=1
    lcClass=班级
    oel.workbooks(1).worksheets(lnCnt).name=lcClass   &&&&&对工作表的名称命名为 DBF表中bj字段中的班级名
    oel.workbooks(1).worksheets(lnCnt).Activate      &&&&& 设置为“活动的工作表”或“当前工作表”
    oel.ActiveSheet.Cells.Select                   &&&&& 选定整张工作表
    oel.Selection.NumberFormatLocal = "@"        &&&&& 将整张工作表的单元格格式设置为“文本”,以改名身份证号成为科学记数状
    oel.ActiveSheet.Range("A1").Select         &&&&&
    FOR gncount=1 to FCOUNT()                 &&&&& 按DBF表的字段数循环
      oel.workbooks(1).worksheets(lnCnt).cells(lnRow,gncount).value=FIELD(gncount)   &&& 此循环在第一行写入字段名
    NEXT
  ENDIF
  lnRow=lnRow+1           &&&从第二行开始写入分班的内容,用于控制EXCEL中的行
  FOR gncount=1 to FCOUNT()     &&&&& 此“FOR……NEXT”循环只完成将DBF表中一条记录转入到EXCEL中的一行
    oel.workbooks(1).worksheets(lnCnt).cells(lnRow,gncount).value=EVALUATE(FIELD(gncount))   &&& 此循环完成下面注释掉的四句的功能,这样实现了动态
  NEXT
*!*      oel.workbooks(1).worksheets(lnCnt).cells(lnRow,1).value=班级
*!*      oel.workbooks(1).worksheets(lnCnt).cells(lnRow,2).value=学号
*!*      oel.workbooks(1).worksheets(lnCnt).cells(lnRow,3).value=姓名
*!*      oel.workbooks(1).worksheets(lnCnt).cells(lnRow,4).value=性别  
ENDSCAN
oel.workbooks(1).SaveAs("tmp.xls")   &&&工作簿另为
*oel.workbooks(1).saved=.t.   &&& 放弃存盘
oel.workbooks(1).close    &&& 关闭工作簿
oel.QUIT                 &&& 退出Excel

MESSAGEBOX('已按班级生成在不同的工作表上了!',64,'生成提示:')
搜索更多相关主题的帖子: 记录 工作表 excel 成绩表 数据表 
2011-12-17 10:52
panpende
Rank: 8Rank: 8
等 级:蝙蝠侠
威 望:4
帖 子:528
专家分:963
注 册:2009-4-27
收藏
得分:3 
学习了。
2011-12-17 11:30
hu9jj
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:红土地
等 级:贵宾
威 望:400
帖 子:11857
专家分:43421
注 册:2006-5-13
收藏
得分:7 
*----------------------------------------------------
*
*此外需加一判断,如果用户的电脑上未装EXCEL软件,则结束运行。   此判断不会写,请高手赐教
*
*----------------------------------------------------
oel=NewObject('Excel.Application')    &&&&这是创建EXCEL对象
if oel<1                              &&可以加在这里试试
    messagebox("建立EXCEL文件失败,请检查OFFICE是否正常!")
    retune
endif

活到老,学到老!http://www.(该域名已经被ISP盗卖了)E-mail:hu-jj@
2011-12-17 12:45
wengjl
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:109
帖 子:2214
专家分:3882
注 册:2007-4-27
收藏
得分:0 
谢谢

只求每天有一丁点儿的进步就可以了
2011-12-17 13:22
wengjl
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:109
帖 子:2214
专家分:3882
注 册:2007-4-27
收藏
得分:0 
以下是引用hu9jj在2011-12-17 12:45:19的发言:

*----------------------------------------------------
*
*此外需加一判断,如果用户的电脑上未装EXCEL软件,则结束运行。   此判断不会写,请高手赐教
*
*----------------------------------------------------
oel=NewObject('Excel.Application')    &&&&这是创建EXCEL对象
if oel<1                              &&可以加在这里试试
    messagebox("建立EXCEL文件失败,请检查OFFICE是否正常!")
    retune
endif
测试提示出错,但您给了我一个思路:用 “ ?OEL ”让其显示,看到了“(对象)”。于是用TYPE()$"Oo"测试,还是通不过提示出错。
再用“ ? type() ”也出错。再用“? varTYPE(oel)”,屏幕上显示O,于是成功了。
即:
oel=NewObject('Excel.Application')    &&&&这是创建EXCEL对象
IF !VARTYPE(oel)$"Oo"      &&& 如果用户的电脑上未装EXCEL软件,则结束运行。
    messagebox("建立EXCEL文件失败,请检查OFFICE是否正常!")
    RETURN
ENDIF

再次感谢HU9JJ

只求每天有一丁点儿的进步就可以了
2011-12-17 13:41
wengjl
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:109
帖 子:2214
专家分:3882
注 册:2007-4-27
收藏
得分:0 
oel.workbooks(1).SaveAs("tmp.xls")   &&&工作簿另为
*oel.workbooks(1).saved=.t.   &&& 放弃存盘
oel.workbooks(1).close    &&& 关闭工作簿
oel.QUIT                 &&& 退出Excel

MESSAGEBOX('已按班级生成在不同的工作表上了!',64,'生成提示:')
又有问题了:当第二次运行代码时,保存工作簿时,出现EXCEL的是否覆盖提示对话框,选择否,VFP代码中的退出EXCEL语句就不执行了,选择是文件覆盖,VFP代码能执行到底。现在想,不让EXCEL的保存覆盖对话框出现,该加一条什么样的语句?

只求每天有一丁点儿的进步就可以了
2011-12-17 14:03
wengjl
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:109
帖 子:2214
专家分:3882
注 册:2007-4-27
收藏
得分:0 
终于找到并试成功了。

oel.DisplayAlerts=.F.           &&&&关闭EXCEL系统的对话框

只求每天有一丁点儿的进步就可以了
2011-12-17 14:17
hu9jj
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:红土地
等 级:贵宾
威 望:400
帖 子:11857
专家分:43421
注 册:2006-5-13
收藏
得分:0 
我还没有来得及测试呢,楼主的钻研精神可嘉。

活到老,学到老!http://www.(该域名已经被ISP盗卖了)E-mail:hu-jj@
2011-12-17 21:44
xs591222
Rank: 9Rank: 9Rank: 9
等 级:贵宾
威 望:28
帖 子:682
专家分:1299
注 册:2009-3-1
收藏
得分:0 
学习了,谢谢
2011-12-18 18:37
快速回复:将数据按班导出到同EXCEL的不同工作表上代码的改进反馈,并求助!
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.020434 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved