非常感谢高老师的无私奉献。我在我的程序中用了你的这段代码，太方便了。
Thank you very much!!!

能让你受益，是我非常高兴的事情，何况又是同龄人．希望以后多交流，还我，我其它的贴也请你看看，也许会用得着！

谢谢高老师的回复。本人水平有限，向你学习才是。
您的这段代码，是将一个表转excel一个工作簿中，表名作为sheet名称。
我有四个表，结构完全一样，一个季度使用一次。我想分次结转到excel中，在一个工作簿中，sheet1存放表1，sheet2存放表2，sheet3存放表3，sheet4存放表4。
请较高老师如何实现？

高老师的创作很好，学习了你的Excel到dbf的转换过程，对我很有帮助，我一直再用。

回WZXC:
人说猩猩相惜,君子爱君子,英雄惜英雄.
如果说我对你有好感的话,是因为我们都是VFP爱好者,但是你提的问题让我有点不敢认同你了.
其实,我发此主题贴的目的不单纯是给大家使用的,更有重要的是希望能起到抛砖引玉的作用.如果你真的想向我学习,你不妨自己认真地研究一下我的代码,然后解决你的问题.而不是轻易发问.我之所不想告诉你该怎么做,真的是想激发你的钻研精神.
你提的问题我暂时不想回答你,是希望能给你更多思考的机会.
在这里我只想提示你以下语句可能对解决你的问题有用:
XLApp.Workbooks.add[xlWBatWorksheet]
XLApp.Workbooks[1].Worksheets[1].Name = myalias
Sheet = XLApp.Workbooks[1].Worksheets[myalias]

ZCl 朋友,谢谢你关注本贴,也谢谢你使用本人代码,也希望你能和wzxc一起研究我的代码,解决wzxc的问题.

谢谢高老师提示。
谢谢你的厚爱，其实您高看我了，我有几把刷子我自己知道。
我水平不高，没有学历，初中没学好，高中没学完。vba我一窍不通。
种子乐老师知道我的底细。
http://www.programfan.com/club/post-258734.html
尽管我非常热爱编程，真想深入地学习。尽管我为我公司编写软件，但很多事情一言难尽，难以充分深入地学习，有太多太多的.................。有时真想放弃，可心中的那份热爱，让我坚持着。

你的批评是对的。我也曾看中了一本关于vba的书，但最终还是没有买下。一言难尽。

DING

[quote]早晨听见乌鸦叫,感觉也挺好!

有思想的乌鸦比只会报喜的喜鹊好,乌鸦兄论述得很对.此程序虽然速度慢点,但已经可以满足应到之需了.

当然,也不能固步自封,10楼的意见,我也一直在考虑.我在想,如果能用复制/粘贴方法的话很可能会加快速度.这就涉及到怎样把数据表记录全部放到剪切板上去的问题,我想都是微软的东东,应该有座沟通的桥梁吧!

希望高手们不断努力,群策群力,共同解决这个问题![/quote]


[color=FF0000][b]HOHO,今天在讨论过程中发现一个方法:

_vfp.datatoclip()
难道这个就是'高速公路'了?
以后TBF--EXCEL再也不自己挖'隧道'了.

SELECT * FROM test WHERE 商品类型='器械仪器2' INTO CURSOR temp
_vfp.DataToClip(,,3)
oMyXLS.Worksheets("sheet1").Activate
oMyXLS.ActiveSheet.Paste

用SQL语句先查询出结果到临时表,想拷贝数据到哪个工作表,激活哪个工作表就行了,爱贴哪贴哪,也解决了COPY TO 产生多个文件,不能在同个文件的不同工作表里追加的问题.
速度基本和COPYTO差不多,要处理内存和CPU使用率的话,我想还是要分块拷贝,虽然你可以一次性的拷贝.[/b][/color]




datatoclip 方法
应用于 请参阅

将一组记录作为文本复制到剪贴板上。

语法

ApplicationObject.DataToClip([nWorkArea | cTableAlias]
[, nRecords] [, nClipFormat])

设置

nWorkArea

指定表的工作区编号，从该表中将记录复制到剪贴板上。如果省略cTableAlias 和 nWorkArea，则从当前工作区的打开表中复制记录。

cTableAlias

指定表的别名，从该表中将记录复制到剪贴板上。

nRecords

指定要复制到剪贴板上的记录数。如果 nRecords 比表中的记录多，则将所有记录复制到剪贴板上。如果省略 nRecords 和 nClipFormat，则将当前记录和所有其他记录复制到剪贴板上。

nClipFormat

指定如何分隔字段。NClipFormat 的设置有：

nClipFormat 说明 
1 (默认值)使用空格分隔字段。 
3 使用制表符分隔字段。 


如果省略 nClipFormat，也使用空格分隔字段。

说明

字段名位于文本的第一行，后面是一行一个记录。

改造后的代码如下：
proc dbf_to_xls     && 从dbf-table 到 xl-table
*定义常量
#define True .t.
#define False .f.
#define xlWBatWorksheet  -4167
#define xlAutomatic 0
#define xlNone 1
#define xlContinuous 1
#define xlThin 2          && 等于1时为点线，2为细线，3为粗线，4更粗
XLApp = createobject("Excel.Application")
XLApp.Workbooks.add[xlWBatWorksheet]
_vfp.DataToClip(,,3)              && 将当前工作区中数据记录复制到剪切板
XLApp.Worksheets(1).Activate      && 激活工作表
XLApp.ActiveSheet.Paste           && 粘贴剪切板中数据记录到EXCEL表  
XLApp.Workbooks(1).Worksheets(1).Name = alias()
XLApp.visible = True
Selection=XLApp.Range(XLApp.Cells(1,1),XLApp.Cells(1,FCOUNT()))   && 设定范围为第一行
Selection.font.bold = .t.           && 字体加粗
Selection.horizontalAlignment = 3   && 水平居中排列
Selection=XLApp.Range(XLApp.Cells(1,1),XLApp.Cells(RECCOUNT()+1,FCOUNT()))  && 设定范围为有数据的整个区域
Selection.font.size = 9    && 体字大小为 9 号
XLApp.Workbooks[1].Sheets[1].rows.rowHeight=20   && 行距为20
XLApp.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"  && 设定第一行为每页必须打印的行
* 设定表格边线
for i=1 to 4
  With Selection.Borders(i)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  EndWith
endfor
retu
----------------------------------------------------------------
    经测试，导出８９０多条记录，用原代码需要约５６秒钟,用以上代码,仅用了3秒钟,速度提高了近20倍.
    非常感谢Vii先生,并向Vii致敬!
    没评30分是因为前面已经评过一次30分了.

    但是,也有问题,就是字符型字段的空格问题和字符型长数字串被转移到EXCEL里面以后变成了用科学记数法表示的数值.
    不过,Vii先生提供的函数是一个了不起的发现,相信这个函数一定能发挥作用!再次感谢Vii,再次向Vii致敬!
   

这是修正后的代码：

proc dbf_to_xls     && 从dbf-table 到 xl-table
*定义常量
#define True .t.
#define False .f.
#define xlWBatWorksheet  -4167
#define xlAutomatic 0
#define xlNone 1
#define xlContinuous 1
#define xlThin 2          && 等于1时为点线，2为细线，3为粗线，4更粗
XLApp = createobject("Excel.Application")
XLApp.Workbooks.add[xlWBatWorksheet]
Sheet = XLApp.Workbooks[1].Worksheets[1]
Sheet.Name = alias()
*设定字符型字段所对应的EXCEL列为字符型
FOR i = 1 TO FCOUNT()
  cfieldname = field(i)
  colName = IIF(INT(i/26) = 0,'',CHR(64+INT(i/26))) + CHR(64+MOD(i,26))
  cRange = colName+'2:'+colName+ALLTRIM(STR(RECCOUNT()+1))
  IF TYPE(cfieldname) = "C"
    sheet.range(cRange).NumberFormatLocal = "@"   && 设置单元格数据类型为字符型，以避免数字字符变为数值型
  ENDIF
ENDFOR
_vfp.DataToClip(,,3)              && 将当前工作区中数据记录复制到剪切板
XLApp.Worksheets(1).Activate      && 激活工作表
XLApp.ActiveSheet.Paste           && 粘贴剪切板中数据记录到EXCEL表  
XLApp.visible = True
*整理列标题,去掉列名后随的空格
for i = 1 to FCOUNT()
  Sheet.Cells[1,i] = ALLTRIM(sheet.cells[1,i].value)
endfor
*-------------------
Selection=XLApp.Range(XLApp.Cells(1,1),XLApp.Cells(1,FCOUNT()))   && 设定范围为第一行
Selection.font.bold = .t.           && 字体加粗
Selection.horizontalAlignment = 3   && 水平居中排列
Selection=XLApp.Range(XLApp.Cells(1,1),XLApp.Cells(RECCOUNT()+1,FCOUNT()))  && 设定范围为有数据的整个区域
Selection.font.size = 9    && 体字大小为 9 号
XLApp.Workbooks[1].Sheets[1].rows.rowHeight=20   && 行距为20
XLApp.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"  && 设定第一行为每页必须打印的行
* 设定表格边线
for i=1 to 4
  With Selection.Borders(i)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  EndWith
endfor
retu

本代码成功解决了上贴的问题，并且丝毫没有影响转换速度！再再次感谢Vii先生！！