流星雨3电视剧全集续写:多表导出数据到Excel 多个工作表,统一工作簿

&& 名称：CopyToExcel
&& 说明：多表导出数据到Excel 多个工作表,统一工作簿
&& 提供表名如不是本目录,需添加路径或已经打开
&& 名称重复将以数字字符区别
&& 参数：cTableList,源数据表名列表
&& 以方括号"[]"分隔
&& cXLSName, 导出文件名
&& cNameList 名称列表
&& 以方括号"[]"分隔
&& 例： do CopyToExcel with "[cTable1][cTable2][cTable3]","out_XLS","[cTableName1][cTableName2][cTableName3]"
Parameters cTableList , cXLSName ,cNameList
Local cAlias,sys_table,ni,IsOpen
cAlias = Alias() && 保存状态
ni = 0 && 循环变量
If Type("cTableList")<>"C" Or Empty(m.cTableList)
If Empty(m.cAlias)
Wait Window "请给出数据源表..."
Return ''
Else
cTableList = "[" + m.cAlias + "]"
Endif
Else
cTableList = Rtrim(Ltrim(m.cTableList))
Endif
If Type("cXLSName") <> "C" Or Empty(m.cXLSName)
cXLSName = Getfile("Excel文件:xls","导出数据文件名","选择",0,"导出数据文件名")
If Empty(m.cXLSName)
Wait Window "请设置导出数据文件名..."
Return ''
Endif
Endif
sys_table = Sys(2015) && 控制用表
Select 0
Create Cursor (m.sys_table );
(;
nId I ,;
TableName C(128),;
cName C(128) ;
)
Local nTable ,cTableName,cCurTmp
cTableName = ''&& 临时表名
cCurTmp = ''&& 临时文件名
For m.ni = 1 To Len(m.cTableList)
cCurTmp = Strextract(m.cTableList,'[',']',m.ni)
If Empty(m.cCurTmp)
Else
Insert Into (m.sys_table) (nId,TableName) values (m.ni,m.cCurTmp)
Endif
Next
If Type("cNameList") = "C"
For m.ni = 1 To Len(m.cNameList)
cCurTmp = Strextract(m.cNameList,'[',']',m.ni)
If Empty(m.cCurTmp)
&& 参数为空或错误
Else
Update (m.sys_table) Set cName = m.cCurTmp;
WHERE nId = m.ni && 有参数进行修改
Endif
Next
Endif
Update (m.sys_table) Set cName = Justfname(TableName) Where Empty(cName)&& 补充命名
&& 检查重名
cCurTmp = Sys(2015)
Select cName,Count(*) As N From (m.sys_Table) ;
Group By cName Having N > 1 Into Cursor (m.cCurTmp)
If _Tally > 0
Dimension a_tmp[1]
Select * From (m.cCurTmp) Into Array a_tmp
If Used(m.cCurTmp)
Use In (m.cCurTmp)
Endif
For m.ni = 1 To Alen(m.a_tmp)
&& ????
Next
Endif
If Used(m.cCurTmp)
Use In (m.cCurTmp)
Endif

Local oExcel && 对象引用
Local oWindowsOld,oWindowsNew
oExcel = Createobject('Excel.application')
With oExcel
.Workbooks.Add(1) && 新建工作簿
oWindowsOld = .ActiveWindow && 记录窗口
Select (m.sys_Table)
For ni = 1 To Recno()
Go (m.ni) In (m.sys_Table)
cTableName = Ltrim(Rtrim(&sys_Table..TableName))
cName = Ltrim(Rtrim(&sys_Table..cName))
If Used(Justfname(m.cTableName)) && 表已打开
IsOpen = .T.
Else
If Not File(m.cTableName + ".dbf") && 表文件未找到
Wait Window At Sysmetric(1)/2,Sysmetric(2)/2 Chr(10)+Chr(13);
+ Space(20)+"未找到表文件"+(m.cTableName + ".dbf")+Space(30);
+Chr(10)+Chr(13)
Loop
Else
Use (m.cTableName) In 0 Alias(Justfname(m.cTableName))
IsOpen = .F.
Endif && 表文件未找到
Endif
cCurTmp = Sys(2015)
Select * From Justfname(m.cTableName) Into Cursor (m.cCurTmp)
Wait Window At Sysmetric(1)/2,Sysmetric(2)/2;
Chr(10)+Chr(13)+Chr(10)+Chr(13);
+Space(20)+"正在导入表"+(m.cTableName)+Space(30)+Chr(10)+Chr(13);
+Space(30)+"请稍后..." +Chr(10)+Chr(13) +Chr(10)+Chr(13);
Nowait Noclear
If IsOpen && 原表已打开
Else
If Used(Justfname(m.cTableName))
Use In (Justfname(m.cTableName))
Endif
Endif
Copy To Addbs(Sys(2023))+m.cCurTmp Type Fox2x && 复制到兼容版本
If Used(m.cCurTmp)
Use In (m.cCurTmp)
Endif
.Workbooks.Open(Addbs(Sys(2023))+m.cCurTmp)
oWindowsNew = .ActiveWindow && 记录窗口
.Rows("1:"+Ltri(Str(_Tally + 1 ))).Select && _TALLY + 1 表的行数 + 1(标题)
.Selection.Copy &&复制
oWindowsOld.Activate && 返回原窗口
If m.ni > 1
.Worksheets.Add() && 添加新的工作表
Endif
.ActiveSheet.Name = m.cName && 更改命名
.Range("A1").Select && 从细节行位置开始
.Selection.pasteSpecial() && 粘贴
.Application.CutCopyMode = .F. &&取消win选择状态
oWindowsNew.Activate
.ActiveWindow.Close(.F.) &&关闭临时 Excel 文件
If File(Addbs(Sys(2023))+m.cCurTmp + ".dbf") && 删除临时表
Delete File (Addbs(Sys(2023))+m.cCurTmp + ".dbf")
Endif
If File(Addbs(Sys(2023))+m.cCurTmp + ".fpt") && 删除临时表备注文件
Delete File (Addbs(Sys(2023))+m.cCurTmp + ".fpt")
Endif
If Used(m.cCurTmp)
Use In (m.cCurTmp)
Endif
Next
&&.Visible = .T.
.ActiveSheet.SaveAs(m.cXLSName)
.Quit
Endwith
Release oExcel
Wait Window "导入工作完成" Clear
If Used(m.sys_table)
Use In (m.sys_table)
Endif
If Empty(m.cAlias)
Else
Select (m.cAlias) && 恢复表环境
Endif