将一个包含有2层数据分组的表输出到EXCEL表里,并分组统计

*– 程序说明:将一个包含有2层数据分组的表输出到EXCEL[/b]表里,并分组统计
*– 原创作者:红虎 于 2001年1月29日
*– 自定义函数:
* letter2num 将列字母转换成相应的数字顺序,传递字母,返回数字
* num2letter 将数字顺序转换成相应的列字母,传递数字,返回字母
* itmcls2name 将itmclass代码转成相应的名称
if messagebox(”在程序执行过程中,请耐性等待,直至程序运行完毕!”,1+48,”警告”) =2
retu
endif

*– 包含有VBA宏里的值[/b]的英文代码转换到VFP[/b]里相应的值[/b]
#include vb_marco.h
*– 创建 EXCEL[/b] 实例对象
oExcel 
= CreateObject(”excel[/b].application”)
*– 开始在 EXCEL[/b] 里添加数据 …
With oExcel
.visible 
= .T. && 可见
.Workbooks.Add 
&& 增加一个工作薄
.Sheets(”Sheet1″).Select
.Sheets(”Sheet1″).Name 
= “sample” && 改变SHEET名称

.Application.WindowState 
= xlMaximized && 最大化 EXCEL[/b]
.Cells.Select 
&& 全选工作簿
With .Selection.Font
.Name 
= “宋体”
.Size 
= 9
.Strikethrough 
= False
.Superscript 
= False
.Subscript 
= False
.OutlineFont 
= False
.Shadow 
= False
.Underline 
= xlUnderlineStyleNone
.ColorIndex 
= xlAutomatic
EndWith
.range(”c1″) 
= “1999 年产品预算资料” && 显示报表标题
.Rows(”
1:1″).RowHeight = 41.25
.Range(”c1:t1″).select 
&& 选择报表标题
.Range(”c1:t1″).merge 
&& 合并
With .Selection
.HorizontalAlignment
= xlCenter
.VerticalAlignment 
= xlMedium
.Font.Bold 
= True
.Font.Size 
= 20
Endwith
.ActiveWindow.Zoom 
= 50 && 50%显示
*– 报表表格的表头,横向顺序显示
dime rpt_header(
20)
rpt_header(
1= “类别”
rpt_header(
2= “组别”
rpt_header(
3= “产品名称”
rpt_header(
4= “单价”
rpt_header(
5= “单位”
rpt_header(
6= “生效日期”
rpt_header(
7= “一月份”
rpt_header(
8= “二月份”
rpt_header(
9= “三月份”
rpt_header(
10= “四月份”
rpt_header(
11= “五月份”
rpt_header(
12= “六月份”
rpt_header(
13= “七月份”
rpt_header(
14= “八月份”
rpt_header(
15= “九月份”
rpt_header(
16= “十月份”
rpt_header(
17= “十一月份”
rpt_header(
18= “十二月份”
rpt_header(
19= “数量合计”
rpt_header(
20= “金额合计”
*– 添加表头数据
for n=1 to 20
cn 
= num2letter(n)
.Range(”
&cn.2″).select && 选择当前列的第 2 行
.Range(”
&cn.2″) = rpt_header(n) && 填充数据
endfor
.Range(”d2,g2:t2″).Select
.Selection.HorizontalAlignment 
= xlRight && 居右对齐
*– 添加表中数据
dime datalist(
18)
datalist(
1= “itmclass”
datalist(
2= “majcod”
datalist(
3= “allt(descrp1)”
datalist(
4= “price”
datalist(
5= “unitpkg”
datalist(
6= “pdate”
datalist(
7= “m01″
datalist(
8= “m02″
datalist(
9= “m03″
datalist(
10= “m04″
datalist(
11= “m05″
datalist(
12= “m06″
datalist(
13= “m07″
datalist(
14= “m08″
datalist(
15= “m09″
datalist(
16= “m10″
datalist(
17= “m11″
datalist(
18= “m12″
if !used(”sample_item”)
use sample_item 
in 0 share
endif
sele sample_item
count 
to nMaxRec && 计算这个表共有的记录数
= 0
nStartLine 
= 3 && 数据从第三行开始
*– 对整个表进行从头到为的循环处理
scan
cnLine 
= allt(str(i+nStartLine)) && 当前数据的行号
for n=1 to 18 && 在一个记录中,对字段进行循环填充
Cell 
= num2letter(n)+cnLine && 当前需要填充数据的单元格
.Range(”
&Cell”).Select && 选择该单元格
data 
= datalist(n)
.Range(”
&Cell”) = &data
endfor
= i + 1
endscan
*– 对数量合计进行填充,她等于 m01+m02++m12的合计
*– 对金额合计的填充则等于数量合计*单价
*– 数量合计在第19列,金额合计在第20列
*– 所以针对第一行进行加入公式,然后进行复制
cRow 
= allt(str(nStartLine))
cMaxRow 
= allt(str(nStartLine+i-1)) && 最后行的行数
.Range(”s
&cRow”).Select && 选择第一行的合计数量单元格
.Range(”s
&cRow”) = “=sum(g&cRow.:r&cRow)” && 加入计算她的合计数字的公式
.Range(”t
&cRow”) = “= s&cRow * d&cRow” && 加入合计金额的计算公式
.Range(”s
&cRow.:t&cRow”).Select && 选择合计金额
.Range(”s
&cRow.:t&cRow”).Copy && 复制该两个选择的单元格
.Range(”s
&cRow.:t&cMaxRow”).Select && 选择需要粘贴的单元格
.ActiveSheet.Paste 
&& 粘贴所复制的两项
.Range(”g
&cRow.:s&cMaxRow”).Select && 选择全部1-12月数字的区域
.Range(”g
&cRow.:s&cMaxRow”).NumberFormatLocal = “#,##0_ ;[红色]-#,##0 ” && 选择数字区域的单元格,设置他们的格式
.Range(”s
&cRow.:t&cMaxRow”).Select
With .Selection.Interior
.ColorIndex 
= 43
.Pattern 
= xlSolid
EndWith
*– 数据填充完毕,下面进行数据的分组
*– 分组由外面先分,即对itmclass分组,然后再对majcod进行分组
*– 而这个时候需要选择包括表头和所有数据在内的所有的区域
*– 在给ITMCLASS做数据分组时,只要选择从表头开始到最后行的数据即可,
* 可是在给MAJCOD继续做数据分组时,因第一次的分组而加入了分组数据,导致数据行已经增加了
* 因此需要重新计算去选择新的范围,而所加的内容的多少视具体分组情况而定
*– 分组统计
sele itmclass,majcod,majdsc from sample_item into cursor temp_source
sele recn() 
as rec_no,itmclass,majcod,majdsc from temp_source into cursor temp
nTotal1 
= _tally && 原有记录
use 
in temp_source
sele 
* from temp group by itmclass into cursor temp_grp_itmclass
nTotal2 
= nTotal1 + _tally + 1 && 加上类别分组后的数据行数
sele 
* from temp group by itmclass,majcod into cursor temp_grp_majcod
nTotal3 
= nTotal2 + _tally + 1 && 加上组别分组后的数据行数
*- 产生一个同EXCEL[/b]里同样格式的表
create cursor cursor_excel[
/b] ( ;
rec_no n (
8) ,;
itmclass c (
1) ,;
majcod c (
3) ,;
majdsc c (
30) )
= 1
sele temp_grp_majcod
scan
*– 分组小计统计数据
sele cursor_excel[
/b]
appe blank
repl rec_no 
with temp_grp_majcod.rec_no + nStartLine - 1 + i
repl itmclass 
with temp_grp_majcod.itmclass
repl majcod 
with temp_grp_majcod.majcod
repl majdsc 
with allt(temp_grp_majcod.majdsc) + ” 分组小计”
= i + 1
sele temp_grp_itmclass
loca 
for rec_no = temp_grp_majcod.rec_no
if found()
*– 分类小计统计数据
sele cursor_excel[
/b]
appe blank
repl rec_no 
with temp_grp_itmclass.rec_no + nStartLine - 1 + i
repl itmclass 
with temp_grp_itmclass.itmclass
repl majcod 
with temp_grp_itmclass.majcod
repl majdsc 
with itmcls2name(itmclass) + ” 生产线小计”
= i + 1
endif
endscan
use 
in temp_grp_itmclass
use 
in temp_grp_majcod
use 
in temp
*– 添加两个总计行
sele cursor_excel[
/b]
go bott
= rec_no
appe blank
repl rec_no 
with n+1
repl majdsc 
with “最终合计”
appe blank
repl rec_no 
with n+2
repl majdsc 
with “最终合计”
*– 至此得到一个临时表cursor_excel[/b],
* 其字段rec_no所记录的数据与EXCEL[/b]表里通过两次分组再自动排序后的行号一致
* 这些信息可以用来改写分组的数据
*– 在EXCEL[/b]中对类别分组
* 开始行为 nStartLine -1 ,结束行为 nTotal1 + nStartLine -1 , 列A-T
cRow 
= allt(str(nStartLine-1))
cMaxRow 
= allt(str(nTotal1+nStartLine-1))
.Range(”A
&cRow.:T&cMaxRow”).Select
.Range(”A
&cRow.:T&cMaxRow”).SubTotal (1,xlSum,7,True,False,True) && 第7列为M01
*– 在EXCEL[/b]中对组别分组
* 开始行为 nStartLine -1 ,结束行为 nTotal2 + nStartLine -1 , 列A-T
cMaxRow 
= allt(str(nTotal2+nStartLine-1))
.Range(”A
&cRow.:T&cMaxRow”).Select
.Range(”A
&cRow.:T&cMaxRow”).SubTotal (2,xlSum,7,False,False,True) && 第7列为M01
*– 数据分组已经完成,对EXCEL[/b]表格再进行处理
*– 隐藏A、B两列,及隐藏最后一行
sele cursor_excel[
/b]
go bott
cn 
= allt(str(rec_no))
.Columns(”A:B”).Select
.Selection.EntireColumn.Hidden 
= True
.Rows(”
&cn.:&cn”).Select
.Selection.EntireRow.Hidden 
= True

*– 锁放屏幕到75%
.ActiveWindow.Zoom 
= 75
.Range(”c1″).select
.ActiveSheet.Outline.ShowLevels (
3&& 选择分组层数第3
*– 重新改写分组数据
sele cursor_excel[
/b]
scan
cn
=allt(str(rec_no))
.Range(”c
&cn”) = allt(majdsc)
.Range(”c
&cn.:f&cn”).Select
with .Selection
.Merge
.HorizontalAlignment 
= xlRight
endwith
.Range(”g
&cn”).copy
.Range(”h
&cn.:t&cn”).select
.ActiveSheet.Paste
.Range(”c
&cn.:t&cn”).font.bold = True
if right(allt(majdsc),10)=”生产线小计”
.Range(”C
&cn.:t&cn”).Select
With .Selection.Interior
.ColorIndex 
= 6
.Pattern 
= xlSolid
EndWith
endif
endscan

.Range(”t:t”).NumberFormatLocal 
= “#,##0.00_ ;[红色]-#,##0.00 ” && 设置金额的格式为99,999.99
*– 画上表格线
* 开始行为 nStartLine -1 ,结束行为 nTotal3 + nStartLine -1 , 列A-T
cMaxRow 
= allt(str(nTotal3+nStartLine-1))
.Range(”A
&cRow.:T&cMaxRow”).Select
with .Selection
*– 左边
.Borders(xlEdgeLeft).LineStyle 
= xlContinuous
.Borders(xlEdgeLeft).Weight 
= xlMedium
*– 上边
.Borders(xlEdgeTop).LineStyle 
= xlContinuous
.Borders(xlEdgeTop).Weight 
= xlMedium
*– 右边
.Borders(xlEdgeRight).LineStyle 
= xlContinuous
.Borders(xlEdgeRight).Weight 
= xlMedium
*– 下边
.Borders(xlEdgeBottom).LineStyle 
= xlContinuous
.Borders(xlEdgeBottom).Weight 
= xlMedium
*– 里边垂直
.Borders(xlInsideVertical[
/b]).LineStyle = xlContinuous
.Borders(xlInsideVertical[
/b]).Weight = xlThin
*– 里边水平
.Borders(xlInsideHorizontal).LineStyle 
= xlContinuous
.Borders(xlInsideHorizontal).Weight 
= xlThin
endwith 

*– 调整每列宽度
.ActiveWindow.Zoom 
= 100
for n=asc(’C') to asc(’T')
cn
=allt(chr(n))
.columns(”
&cn.:&cn”).entirecolumn.autofit
endfor

*– 打印设置,预览
.ActiveSheet.PageSetup.PrintArea 
= “”
With .ActiveSheet.PageSetup
.LeftHeader 
= “”
.CenterHeader 
= “”
.RightHeader 
= “”
.LeftFooter 
= “”
.CenterFooter 
= “”
.RightFooter 
= “”
.LeftMargin 
= .Application.InchesToPoints(0.75)
.RightMargin 
= .Application.InchesToPoints(0.75)
.TopMargin 
= .Application.InchesToPoints(1)
.BottomMargin 
= .Application.InchesToPoints(1)
.HeaderMargin 
= .Application.InchesToPoints(0.5)
.FooterMargin 
= .Application.InchesToPoints(0.5)
.PrintHeadings 
= False
.PrintGridlines 
= False
.PrintComments 
= xlPrintNoComments
.PrintQuality 
= 180
.CenterHorizontally 
= False
.CenterVertically 
= False
.Orientation 
= xlLandscape
.Draft 
= False
.PaperSize 
= xlPaperA3
.FirstPageNumber 
= xlAutomatic
.Order 
= xlDownThenOver
.BlackAndWhite 
= False
.Zoom 
= 100
EndWith
.ActiveSheet.Outline.ShowLevels (
4&& 选择分组层数第4
.ActiveWindow.SelectedSheets.PrintPreview
Endwith
messagebox(”程序完成!”,
64,”提示”)
*– 自定义函数
*– 将EXCEL[/b]里的列的字母从A-IV转换到相应的数字顺序
Func letter2num
*– 传递来的字母 , 字母会有两种情况,为,一个字母和二个字母
PARA cLetter
private num,cLetter1,cLetter2
num 
= 0
*– 如果传递来的参数不是字符,那么以默认为字母 A
if type(”cLetter”)#”C”
cLetter 
= “A”
endif
*– 转换为大写
cLetter 
= upper(cLetter)
*– 判断位数是否为2位
nLen 
= len(cLetter)
if nLen > 2 or nLen 256
messagebox(”最大只能到 IV 列,即 
256 列!此时返回 256 !”,48,”错误”)
num 
= 256
endif
retu num

*– 将EXCEL[/b]里列的顺序号转换到相应的字母A-IV
Func num2letter
*– 传递来的数字列
para num
private letter,num1,num2
*– 如果传递来的参数不是数字型,以 1 为默认值[/b]
if type(”num”) # “N”
num 
= 1
endif
*– 判断
if num > 256 or num 0 && 表示有十位数
letter 
= chr(num1+64+ letter
endif
retu letter
*– 将itmclass代码转成相应的名称
Func ItmCls2Name
Para cItem_Class
if !cItem_class$”123456789
retu “无”
endif
nItem_
class=val(cItem_class)
dime cItmClsLst(
9)
cItmClsLst(
1= “1 = 嘉顿饼”
cItmClsLst(
2= “2 = 糖”
cItmClsLst(
3= “3 = 包”
cItmClsLst(
4= “4 = 蛋糕”
cItmClsLst(
5= “5 = ??”
cItmClsLst(
6= “6 = ??”
cItmClsLst(
7= “7 = ??”
cItmClsLst(
8= “8 = 月饼”
cItmClsLst(
9= “9 = 利华饼”
retu cItmClsLst(nItem_Class)

posted @ 2008-10-03 13:57  月亮不合眼  阅读(1315)  评论(0编辑  收藏  举报