| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
共有 330 人关注过本帖
标题:如何从“销售明细表.xls”生成“销售统计表.doc”
只看楼主 加入收藏
王咸美
Rank: 1
等 级:新手上路
帖 子:872
专家分:3
注 册:2018-1-4
收藏
得分:0 
下列代码有点长,不知好不好简化,请高手赐教,谢谢!
CLEAR   ALL
CLOSE   ALL
cPath=ADDBS(JUSTPATH(SYS(16)))
SET   DEFAULT   TO   (cPath)
wjm=cPath+"\销售明细表.xls"
FileName=cPath+"\"+"销售统计表.doc"

* 创建Word应用程序对象
oWord = CREATEOBJECT("Word.Application")
oWord.Visible = .T.

* 创建新文档
oDoc = oWord.Documents.Add()

* 添加标题
oWord.Documents(1).range.Text = "销售统计表"
oWord.Documents(1).range.Font.Size = 16
oWord.Documents(1).range.Font.Bold = .T.
oWord.Documents(1).range.Font.Name="宋体"
oWord.Documents(1).range.ParagraphFormat.Alignment = 1

* 连接Excel并读取数据
oExcel = CREATEOBJECT("Excel.Application")
oExcel.Visible = .F.
oWorkbook = oExcel.Workbooks.Open(wjm)
oSheet = oWorkbook.ActiveSheet

* 获取数据范围
nLastRow = oSheet.UsedRange.Rows.Count

* 创建临时表来存储Excel数据
CREATE   CURSOR   temp_data (订单号  C(10), 产品  C(20), 区域  C(10), 数量  N(5), 金额  N(10,2))

* 将Excel数据导入临时表
FOR   i = 2   TO   nLastRow
    lcOrder = ALLTRIM(TRANSFORM(oSheet.Cells(i, 1).Value))
    lcProduct = ALLTRIM(TRANSFORM(oSheet.Cells(i, 2).Value))
    lcArea = ALLTRIM(TRANSFORM(oSheet.Cells(i, 3).Value))
   
    * 获取金额
    lnQty = 0
    lnAmount = 0
   
    * 处理数量
    lcQtyValue = TRANSFORM(oSheet.Cells(i, 4).Value)
    IF   VARTYPE(lcQtyValue) = "C"   AND   !EMPTY(lcQtyValue)
        lnQty = VAL(lcQtyValue)
    ELSE
        lnQty = oSheet.Cells(i, 4).Value
    ENDIF
   
    * 处理金额
    lcAmountValue = TRANSFORM(oSheet.Cells(i, 5).Value)
    IF   VARTYPE(lcAmountValue) = "C"   AND   !EMPTY(lcAmountValue)
        lnAmount = VAL(lcAmountValue)
    ELSE
        lnAmount = oSheet.Cells(i, 5).Value
    ENDIF
   
    INSERT   INTO   temp_data   VALUES (lcOrder, lcProduct, lcArea, lnQty, lnAmount)
ENDFOR

* 获取所有不重复的区域
SELECT   DISTINCT   区域   FROM   temp_data   INTO   CURSOR   cur_areas   ORDER   BY   区域

* 获取所有不重复的产品
SELECT   DISTINCT   产品   FROM   temp_data   INTO   CURSOR   cur_products   ORDER   BY  产品

* 创建Word表格
nRows = RECCOUNT("cur_products") + 2  && 产品行 + 标题行 + 总计行
nCols = RECCOUNT("cur_areas") + 2     && 区域列 + 产品列 + 合计列

oTable = oDoc.Tables.Add(oDoc.Range(oDoc.Range.End-1, oDoc.Range.End-1), nRows, nCols)
oTable.Style = "网格型"

oWord.ActiveDocument.Tables(1).Range.Font.Bold=.F.
oWord.ActiveDocument.Tables(1).Range.Font.size=11
oWord.ActiveDocument.Tables(1).Range.Font.Name="宋体"
oWord.ActiveDocument.Tables(1).Rows(1).Range.Font.Bold=.t.

* 填充表头
oTable.Cell(1, 1).Range.Text = "产品"
SELECT   cur_areas
nCol = 2
SCAN
    oTable.Cell(1, nCol).Range.Text = ALLTRIM(区域)
    nCol = nCol + 1
ENDSCAN
oTable.Cell(1, nCols).Range.Text = "合计"

* 填充产品数据
SELECT   cur_products
nRow = 2
SCAN
    lcProduct = ALLTRIM(产品)
    oTable.Cell(nRow, 1).Range.Text = lcProduct
   
    * 计算每个区域的金额
    SELECT   cur_areas
    nCol = 2
    SCAN
        lcArea = ALLTRIM(区域)
        
        * 使用SQL查询计算金额 - 这是更可靠的方法
        SELECT   SUM(金额)   AS   area_sum   FROM   temp_data ;
        WHERE   ALLTRIM(产品) == lcProduct   AND   ALLTRIM(区域) == lcArea ;
        INTO   CURSOR   temp_area_sum
        
        IF   _TALLY > 0   AND   !ISNULL(temp_area_sum.area_sum)
            oTable.Cell(nRow, nCol).Range.Text = ALLTRIM(STR(temp_area_sum.area_sum, 10, 2))
        ELSE
            oTable.Cell(nRow, nCol).Range.Text = " "
        ENDIF
        
        nCol = nCol + 1
        USE   IN   temp_area_sum
    ENDSCAN
   
    * 计算产品合计
    SELECT   SUM(金额)   AS   product_sum   FROM   temp_data ;
    WHERE   ALLTRIM(产品) == lcProduct ;
    INTO   CURSOR   temp_product_sum
   
    IF   _TALLY > 0   AND   !ISNULL(temp_product_sum.product_sum)
        oTable.Cell(nRow, nCols).Range.Text = ALLTRIM(STR(temp_product_sum.product_sum, 10, 2))
    ELSE
        oTable.Cell(nRow, nCols).Range.Text = "0.00"
    ENDIF
   
    nRow = nRow + 1
    USE   IN   temp_product_sum
ENDSCAN

* 添加总计行
oTable.Cell(nRows, 1).Range.Text = "总计"

* 计算每个区域的总计
SELECT   cur_areas
nCol = 2
SCAN
    lcArea = ALLTRIM(区域)
   
    SELECT   SUM(金额)   AS   area_total   FROM   temp_data ;
    WHERE   ALLTRIM(区域) == lcArea ;
    INTO   CURSOR   temp_area_total
   
    IF   _TALLY > 0   AND   !ISNULL(temp_area_total.area_total)
        oTable.Cell(nRows, nCol).Range.Text = ALLTRIM(STR(temp_area_total.area_total, 10, 2))
    ELSE
        oTable.Cell(nRows, nCol).Range.Text = "0.00"
    ENDIF
   
    nCol = nCol + 1
    USE   IN   temp_area_total
ENDSCAN

* 计算整体总计
SELECT   SUM(金额)   AS   grand_total   FROM   temp_data   INTO   CURSOR   temp_grand
IF   _TALLY > 0   AND   !ISNULL(temp_grand.grand_total)
    oTable.Cell(nRows, nCols).Range.Text = ALLTRIM(STR(temp_grand.grand_total, 10, 2))
ELSE
    oTable.Cell(nRows, nCols).Range.Text = "0.00"
ENDIF

* 关闭Excel
oWorkbook.Close(.F.)
oExcel.Quit()

* 保存Word文档
oDoc.SaveAs(FileName)

* 清理对象
RELEASE   oSheet, oWorkbook, oExcel
RELEASE   oTable, oDoc, oWord

USE   IN   temp_data
USE   IN   cur_areas
USE   IN   cur_products
USE   IN   temp_grand
MESSAGEBOX("Word格式的销售统计表生成完成!", 64, "完成")

3 天前 13:02
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:451
帖 子:10893
专家分:43494
注 册:2014-5-20
收藏
得分:10 
分两部分
1、xls -> dbf    之前已经讨论过就不再重复
2、dbf -> doc    调用 dbf_to_word()

图片附件: 游客没有浏览图片的权限,请 登录注册

程序代码:
CLEAR   ALL
cPath=ADDBS(JUSTPATH(SYS(16)))
SET   DEFAULT   TO   (cPath)

wjm=cPath+"销售明细表.xls"
FileName=cPath+"销售统计表.doc"

* 连接Excel并读取数据
oExcel = CREATEOBJECT("Excel.Application")
oExcel.Visible = .F.
oWorkbook = oExcel.Workbooks.Open(wjm)
oSheet = oWorkbook.ActiveSheet

* 获取数据范围
nLastRow = oSheet.UsedRange.Rows.Count

* 创建临时表来存储Excel数据
CREATE   CURSOR   temp_data (订单号  C(10), 产品  C(20), 区域  C(10), 数量  N(5), 金额  N(10,2))

* 将Excel数据导入临时表
FOR   i = 2   TO   nLastRow
    lcOrder = ALLTRIM(TRANSFORM(oSheet.Cells(i, 1).Value))
    lcProduct = ALLTRIM(TRANSFORM(oSheet.Cells(i, 2).Value))
    lcArea = ALLTRIM(TRANSFORM(oSheet.Cells(i, 3).Value))
   
    * 获取金额
    lnQty = 0
    lnAmount = 0
   
    * 处理数量
    lcQtyValue = TRANSFORM(oSheet.Cells(i, 4).Value)
    IF   VARTYPE(lcQtyValue) = "C"   AND   !EMPTY(lcQtyValue)
        lnQty = VAL(lcQtyValue)
    ELSE
        lnQty = oSheet.Cells(i, 4).Value
    ENDIF
   
    * 处理金额
    lcAmountValue = TRANSFORM(oSheet.Cells(i, 5).Value)
    IF   VARTYPE(lcAmountValue) = "C"   AND   !EMPTY(lcAmountValue)
        lnAmount = VAL(lcAmountValue)
    ELSE
        lnAmount = oSheet.Cells(i, 5).Value
    ENDIF
   
    INSERT   INTO   temp_data   VALUES (lcOrder, lcProduct, lcArea, lnQty, lnAmount)
ENDFOR
* 关闭Excel
oWorkbook.Close(.F.)
oExcel.Quit()

dbf_to_word("temp_data", FileName)

CLOSE TABLES ALL 
CLEAR ALL 
RETURN

FUNCTION dbf_to_word(dbf_alias, cFileName)
    cmd_dbf = "CREATE CURSOR tb (产品 C(20)" 
    cmd_sum = "SELECT '总计'"
    SELECT 区域 DISTINCT FROM (dbf_alias) ORDER BY 区域 INTO CURSOR tmp
    SCAN
        cf = ALLTRIM(区域)
        cmd_dbf = cmd_dbf + ","+cf+" N(10,2)"
        cmd_sum = cmd_sum + ",SUM("+cf+")"
    ENDSCAN
    cmd_dbf = cmd_dbf + ",合计 N(10,2))"
    cmd_sum = cmd_sum + ",SUM(合计)"
    EXECSCRIPT(cmd_dbf)
    SELECT 产品 DISTINCT FROM (dbf_alias) ORDER BY 产品 INTO CURSOR tmp
    SELECT tb
    APPEND FROM DBF("tmp")
    INDEX on 产品 TAG tag_产品
    SELECT 产品,区域,SUM(金额) 金额 FROM (dbf_alias) GROUP BY 区域,产品 INTO CURSOR tmp 
    SET RELATION TO 产品 INTO "tb"
    SCAN
        REPLACE (tmp.区域) WITH tmp.金额, 合计 WITH 合计+tmp.金额 IN "tb"
    ENDSCAN
    DIMENSION arr[1]
    cmd_sum = cmd_sum + " FROM tb INTO ARRAY arr"
    EXECSCRIPT(cmd_sum)
    INSERT INTO tb FROM ARRAY arr
    
        * 创建Word应用程序对象
    oWord = CREATEOBJECT("Word.Application")
        * 创建新文档
    oDoc = oWord.Documents.Add()
        * 添加标题
    oWord.Documents(1).range.Text = "销售统计表"
    oWord.Documents(1).range.Font.Size = 16
    oWord.Documents(1).range.Font.Bold = .T.
    oWord.Documents(1).range.Font.Name="宋体"
    oWord.Documents(1).range.ParagraphFormat.Alignment = 1
        * 创建Word表格
    nRows = RECCOUNT("tb") + 1     && 产品行 + 标题行 + 总计行
    nCols = FCOUNT("tb")           && 区域列 + 产品列 + 合计列
    oTable = oDoc.Tables.Add(oDoc.Range(oDoc.Range.End-1, oDoc.Range.End-1), nRows, nCols)
    oTable.Style = "网格型"
    oWord.ActiveDocument.Tables(1).Range.Font.Bold=.F.
    oWord.ActiveDocument.Tables(1).Range.Font.size=11
    oWord.ActiveDocument.Tables(1).Range.Font.Name="宋体"
    oWord.ActiveDocument.Tables(1).Rows(1).Range.Font.Bold=.t.
        * 填充表头
    FOR i=1 TO FCOUNT("tb")
        oTable.Cell(1, i).Range.Text = FIELD(i,"tb")
    ENDFOR
        * 填充产品数据
    SELECT * FROM tb INTO ARRAY arr
    FOR i=1 TO RECCOUNT("tb")
        FOR j=1 TO FCOUNT("tb")
            oTable.Cell(i+1, j).Range.Text = IIF(VARTYPE(arr[i,j])=="N",TRANSFORM(arr[i,j],"@Z 999,999.99"), arr[i,j])
        ENDFOR
    ENDFOR
        * 保存Word文档
    oDoc.SaveAs(FileName)
    oDoc.Close
    oWord.Quit
    MESSAGEBOX("Word格式的销售统计表生成完成!"+0h0D+FileName, 64, "完成")
    **oWord.Visible = .T.
ENDFUNC



[此贴子已经被作者于2025-11-18 16:43编辑过]

3 天前 16:40
wengjl
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:109
帖 子:2352
专家分:4210
注 册:2007-4-27
收藏
得分:0 

在10楼完成  E 到 D 的基础上,昨天一下午时间,依11楼代码修改调试,完成  D 到 W 部分

CLEAR ALL
SET SAFETY off
SET engi 70
CLOSE DATABASES
cPath=ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cPath)

FileName=cPath+"word_wj.doc"
oWord = CREATEOBJECT("Word.Application")       &&& 创建Word应用程序对象
oWord.Visible = .T.
oDoc = oWord.Documents.Add()                   &&& 创建新文档
oWord.Documents(1).range.Text = "销售统计表"   &&& 添加标题
oWord.Documents(1).range.Font.Size = 16
oWord.Documents(1).range.Font.Bold = .T.
oWord.Documents(1).range.Font.Name="宋体"
oWord.Documents(1).range.ParagraphFormat.Alignment = 1
SELECT * from 统计表 into cursor tt         &&& 为创建Word表格准备(4句)
SELECT tt
nCols=FCOUNT()
nRows=RECCOUNT() + 2
oTable = oDoc.Tables.Add(oDoc.Range(oDoc.Range.End-1, oDoc.Range.End-1), nRows, nCols,1)   &&& 创建表格, 此句oTable.Style = "网格型" 被最后的 1 所替代
oWord.ActiveDocument.Tables(1).Range.Font.Bold=.F.
oWord.ActiveDocument.Tables(1).Range.Font.size=11
oWord.ActiveDocument.Tables(1).Range.Font.Name="宋体"
oWord.ActiveDocument.Tables(1).Rows(1).Range.Font.Bold=.t.   &&& 表格的第一行字体加粗
FOR i=1 to nCols
  oTable.Cell(1, i).Range.Text = FIELD(i)   &&& 填充表头
ENDFOR
nRow = 1
SELECT tt
GO top
SCAN  
  nRow = nRow + 1
  FOR i=1 to nCols
    lcPm = EVALUATE(FIELD(i))
    oTable.Cell(nRow, i).Range.Text = lcPm  &&& 填充“产品&金额”的数据
  ENDFOR
  SELECT tt
ENDSCAN
oTable.Cell(nRows, 1).Range.Text = "总计"   &&& 处理总计行
FOR i=2 to nCols
  sn=0
  SELECT tt
  SCAN
    sn=sn+EVALUATE(FIELD(i))
  ENDSCAN
  oTable.Cell(nRows, i).Range.Text =sn      &&& 记录每个区域的合计数
ENDFOR
FOR i=2 to nCols
  FOR j=2 to nRows
    IF oTable.Cell(j, i).Range.Text = "0"
      oTable.Cell(j, i).Range.Text = ""     &&& 清空 0 值
    ENDIF
  ENDFOR
ENDFOR
oDoc.SaveAs(FileName)                       &&& 保存Word文档
oDoc.close
oWord.quit
CLOSE DATABASES
MESSAGEBOX("Word格式的销售统计表生成完成!", 64, "提示:")
QUIT

只求每天有一丁点儿的进步就可以了
前天 08:51
schtg
Rank: 13Rank: 13Rank: 13Rank: 13
来 自:Usa
等 级:贵宾
威 望:67
帖 子:2325
专家分:4855
注 册:2012-2-29
收藏
得分:0 
向各位大侠学习!
前天 12:14
王咸美
Rank: 1
等 级:新手上路
帖 子:872
专家分:3
注 册:2018-1-4
收藏
得分:0 
谢谢!
前天 13:25
chychychy
Rank: 3Rank: 3
等 级:论坛游侠
帖 子:440
专家分:148
注 册:2015-4-18
收藏
得分:0 
留个脚印,学习了
前天 14:16
wengjl
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:109
帖 子:2352
专家分:4210
注 册:2007-4-27
收藏
得分:0 
为减少13楼的代码,设想总体粘贴,测试:

CLEAR ALL
SET SAFETY off
SET engi 70
CLOSE DATABASES
cPath=ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cPath)
USE 统计表               &&& 10楼已解决
COPY TO ls type xl5
FileName=cPath+"word_wj.doc"

oWord = CREATEOBJECT("Word.Application")       &&& 创建Word应用程序对象
oWord.Visible = .T.
oDoc = oWord.Documents.Add()                   &&& 创建新文档
oWord.Documents(1).range.Text = "销售统计表"   &&& 添加标题
oWord.Documents(1).range.Font.Size = 16
oWord.Documents(1).range.Font.Bold = .T.
oWord.Documents(1).range.Font.Name="宋体"
oWord.Documents(1).range.ParagraphFormat.Alignment = 1
*---
oe=CREATEOBJECT("excel.application")
oe.visible=.T.
oe.DisplayAlerts = 0                      &&& 关闭EXCEL的对话框
oe.WorkBooks.Open(cpath+"ls.xls")         &&& 打开EXCEL文档
as = oe.ActiveSheet
as.UsedRange.copy                         &&& 拷贝用户数据区域
oWord.documents(1).range.pastespecial     &&& 粘贴表格

经粘贴后,观察:EXCEL上的表是粘贴过来了,可前一步添加的标题被覆盖掉了,如何解决?
麻烦高手赐教!谢谢!



只求每天有一丁点儿的进步就可以了
前天 15:02
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:451
帖 子:10893
专家分:43494
注 册:2014-5-20
收藏
得分:0 
试试:
oWord.documents(1).range(2,1).pastespecial
前天 16:22
wengjl
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:109
帖 子:2352
专家分:4210
注 册:2007-4-27
收藏
得分:0 
以下是引用吹水佬在2025-11-19 16:22:12的发言:

试试:
oWord.documents(1).range(2,1).pastespecial


没有通过,出现如下图
图片附件: 游客没有浏览图片的权限,请 登录注册


没找到 控制WORD光标位置的命令!

[此贴子已经被作者于2025-11-19 16:43编辑过]


只求每天有一丁点儿的进步就可以了
前天 16:39
wengjl
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:109
帖 子:2352
专家分:4210
注 册:2007-4-27
收藏
得分:0 
试出来了

图片附件: 游客没有浏览图片的权限,请 登录注册

只求每天有一丁点儿的进步就可以了
前天 16:46
快速回复:如何从“销售明细表.xls”生成“销售统计表.doc”
数据加载中...
 
   



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

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.027034 second(s), 9 queries.
Copyright©2004-2025, BC-CN.NET, All Rights Reserved