将一个包含有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  &&  计算这个表共有的记录数
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)

*– 程序说明：将一个包含有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)

转载于:https://www.cnblogs.com/hylan/archive/2008/10/03/1303448.html