*– 程序说明：将一个包含有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 && 计算这个表共有的记录数
i = 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 = 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) )
i = 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 = 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 = i + 1
endif
endscan
use in temp_grp_itmclass
use in temp_grp_majcod
use in temp
*– 添加两个总计行
sele cursor_excel[/b]
go bott
n = 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)