使用_VFP.DataToClip(),字符串第一个字符是双引号("),粘贴时可能会出现异常,这个问题不好处理。
自定义一个类似的函数 _DataToClip() 来处理(同时处理栏目行和备注字段),速度也差不多。
CREATE CURSOR 测试表 (编号 C(10), 入库单号 C(7), 入库日期 D, 物料名称 C(20), 数量 I,;
单价 N(14,2), 单位 C(8), 规格 C(30), 付款 L, 日期时间 T, 备注 M)
FOR i=1 To 101
INSERT INTO 测试表 VALUES (PADL(i,10,"0"), 'C'+PADL(i,6,'0'), {^2018-03-01}+INT(RAND()*10),;
'物料'+PADL(i,3,'0'), INT(RAND()*1000), RAND()*10, '个', '"测试双引号AB"CD"',;
IIF(i%2=0,.t.,.f.), DATETIME(), '"备注_"'+TRANSFORM(i)+'"'+0h0D0A+'_'+TRANSFORM(i)+'"'+0h0D0A)
ENDFOR
AFIELDS(aFieldInfo)
FOR i=1 TO ALEN(aFieldInfo,1)
aFieldInfo[i,7] = aFieldInfo[i,1] && 可自定义,用作栏目名
aFieldInfo[i,8] = ICASE(; && 数据格式
aFieldInfo[i,2]=="I", '##0;[=0]""',; && 整数格式
INLIST(aFieldInfo[i,2],"B","N","F"), '#,##0.'+REPLICATE("0",aFieldInfo[i,4])+';[=0]""',; && 小数格式
INLIST(aFieldInfo[i,2],"C","V","W","M"), '@',; && 文本格式
aFieldInfo[i,2]=="D", 'yyyy-m-d',; && 日期格式
aFieldInfo[i,2]=="T", 'yyyy-m-d hh:mm:ss',; && 日期时间格式
'G/通用格式')
ENDFOR
t1=SECONDS()
_DBF_EXCEL("C:\TEMP\test.xls", "测试表", @aFieldInfo, 20, 4, 1, "数 据 导 出 表", 2)
? SECONDS()-t1
RETURN
**
** DBF转EXCEL
** _DBF_EXCEL(cOutFile, cAlias, aFieldInfo, nPageRows, nStartRow, nStartCol, cTitle, nTitleRow)
** cOutFile 输出EXCEL文件名
** cAlias DBF表工作区别名
** aFieldInfo 字段信息,用AFIELDS()获取,可自定义栏目名、数据格式等。
** nPageRows 每页数据行数
** nStartRow 开始行
** nStartCol 开始列
** cTitle 标题
** nTitleRow 标题行
**
FUNCTION _DBF_EXCEL(cOutFile, cAlias, aFieldInfo, nPageRows, nStartRow, nStartCol, cTitle, nTitleRow)
LOCAL oExcel
oExcel = CREATEOBJECT("Excel.Application") && 创建电子表格
oExcel.DisplayAlerts = .F. && 关闭 Excle 提示对话框
oExcel.WorkBooks.Add && 创建工作簿
* 如果页数多了,删除多余的
LOCAL nPageCount
nPageCount = CEILING(RECCOUNT(cAlias)/nPageRows) && 页数
DO WHILE oExcel.Worksheets.Count > nPageCount
oExcel.Sheets[oExcel.Worksheets.Count].Select
oExcel.ActiveWindow.SelectedSheets.Delete
ENDDO
* 如果页数不够,添加
FOR i=oExcel.Worksheets.Count+1 TO nPageCount
oExcel.Sheets.Add
ENDFOR
* 页名
FOR i=1 TO nPageCount
oExcel.Sheets[i].Name = "第"+TRANSFORM(i)+"页"
ENDFOR
* 利用剪贴板把DBF内容复制到EXCEL表
SELECT (cAlias)
LOCAL nRow, nCol, nEndRow, nEndCol
nEndRow = nStartRow + nPageRows && 结束行,第1行为栏目行
nEndCol = nStartCol + ALEN(aFieldInfo,1) - 1 && 结束列
FOR i=1 TO nPageCount && 处理各页
WITH oExcel
* 打开页
.Sheets[i].Activate
* 标题格式设置
.Range(.Cells(nTitleRow,nStartCol), .Cells(nTitleRow,nEndCol)).Select
.Selection.NumberFormatLocal = "@" && 文本格式
.Selection.HorizontalAlignment = -4108 && 居中 xlCenter
.Selection.VerticalAlignment = -4108
.Selection.Merge && 合并单元格
* 栏目行格式设置
.Range(.Cells(nStartRow,nStartCol), .Cells(nStartRow,nEndCol)).Select
.Selection.NumberFormatLocal = "@"
.Selection.HorizontalAlignment = -4108 && 居中 xlCenter
.Selection.VerticalAlignment = -4108
* 各列数据格式设置
FOR nCol=nStartCol TO nEndCol
.Range(.Cells(nStartRow+1,nCol), .Cells(nEndRow,nCol)).Select
.Selection.NumberFormatLocal = aFieldInfo[nCol-nStartCol+1, 8]
ENDFOR
.Cells(nTitleRow,nStartCol).Value = cTitle && 标题
GO (i-1)*nPageRows + 1 && 每页第一行的数据记录位置
* 使用_VFP.DataToClip(),字符串第一个字符是双引号("),粘贴时可能会出现异常
* 自定义一个类似的函数 _DataToClip() 来处理(同时处理栏目行和备注字段)
_DataToClip(cAlias, @aFieldInfo, nPageRows) && 复制DBF记录
.Range(.Cells(nStartRow,nStartCol), .Cells(nEndRow,nEndCol)).Select
.ActiveSheet.Paste && 粘贴到EXCEL
.Cells(1,1).Select
.Columns.AutoFit && 自动适应行列宽
.Rows.AutoFit
ENDWITH
ENDFOR
oExcel.Sheets[1].Activate && 打开第1页
* 调试观察时用
** oExcel.ActiveWindow.WindowState = 2 && 最大化窗口
** oExcel.Caption = cTitle && Excel标题
** oExcel.Visible = .T.
** MESSAGEBOX("中断预览")
* 保存关闭
oExcel.ActiveWorkbook.SaveAs(cOutFile, -4143) && 另存, 常规工作簿格式,xlNormal:-4143
oExcel.Workbooks.Close && 关闭工作簿
oExcel.Quit && 关闭Excel
RELEASE oExcel && 释放oExcel
ENDFUNC
* DBF复制数据到剪贴板
* 数据格式:列分隔符为制表符,行分隔符为回车符
* "列1数据"制表符"列2数据"制表符 ...... 制表符"列n数据"回车符
FUNCTION _DataToClip(cAlias, aFieldInfo, nRecord)
SELECT (cAlias)
IF EOF()
RETURN .F.
ENDIF
LOCAL i, cMem
cMem = '"' + STRTRAN(aFieldInfo[1,7], '"', '""') + '"'
FOR i=2 TO ALEN(aFieldInfo,1)
cMem = cMem + 0h09 + '"' + STRTRAN(aFieldInfo[i,7], '"', '""') + '"'
ENDFOR
cMem = cMem + 0h0D
SCAN NEXT nRecord
cMem = cMem + _GetData(@aFieldInfo, 1)
FOR i=2 TO ALEN(aFieldInfo,1)
cMem = cMem + 0h09 + _GetData(@aFieldInfo, i)
ENDFOR
cMem = cMem + 0h0D
ENDSCAN
_CLIPTEXT = cMem
RETURN .T.
ENDFUNC
FUNCTION _GetData(aFieldInfo, nFieldNum)
LOCAL cMem
cMem = ICASE(;
aFieldInfo[nFieldNum,2]=="I", '"'+TRANSFORM(EVALUATE(aFieldInfo[nFieldNum,1]))+'"',;
INLIST(aFieldInfo[nFieldNum,2],"B","N","F"), '"'+;
LTRIM(STR(EVALUATE(aFieldInfo[nFieldNum,1]),aFieldInfo[nFieldNum,3],aFieldInfo[nFieldNum,4]))+'"',;
INLIST(aFieldInfo[nFieldNum,2],"C","V","W","M"), '"'+STRTRAN(EVALUATE(aFieldInfo[nFieldNum,1]),'"','""')+'"',;
aFieldInfo[nFieldNum,2]=="D", '"'+DTOC(EVALUATE(aFieldInfo[nFieldNum,1]))+'"',;
aFieldInfo[nFieldNum,2]=="T", '"'+TTOC(EVALUATE(aFieldInfo[nFieldNum,1]))+'"',;
'"'+TRANSFORM(EVALUATE(aFieldInfo[nFieldNum,1]))+'"')
RETURN cMem
ENDFUNC
自定义一个类似的函数 _DataToClip() 来处理(同时处理栏目行和备注字段),速度也差不多。
CREATE CURSOR 测试表 (编号 C(10), 入库单号 C(7), 入库日期 D, 物料名称 C(20), 数量 I,;
单价 N(14,2), 单位 C(8), 规格 C(30), 付款 L, 日期时间 T, 备注 M)
FOR i=1 To 101
INSERT INTO 测试表 VALUES (PADL(i,10,"0"), 'C'+PADL(i,6,'0'), {^2018-03-01}+INT(RAND()*10),;
'物料'+PADL(i,3,'0'), INT(RAND()*1000), RAND()*10, '个', '"测试双引号AB"CD"',;
IIF(i%2=0,.t.,.f.), DATETIME(), '"备注_"'+TRANSFORM(i)+'"'+0h0D0A+'_'+TRANSFORM(i)+'"'+0h0D0A)
ENDFOR
AFIELDS(aFieldInfo)
FOR i=1 TO ALEN(aFieldInfo,1)
aFieldInfo[i,7] = aFieldInfo[i,1] && 可自定义,用作栏目名
aFieldInfo[i,8] = ICASE(; && 数据格式
aFieldInfo[i,2]=="I", '##0;[=0]""',; && 整数格式
INLIST(aFieldInfo[i,2],"B","N","F"), '#,##0.'+REPLICATE("0",aFieldInfo[i,4])+';[=0]""',; && 小数格式
INLIST(aFieldInfo[i,2],"C","V","W","M"), '@',; && 文本格式
aFieldInfo[i,2]=="D", 'yyyy-m-d',; && 日期格式
aFieldInfo[i,2]=="T", 'yyyy-m-d hh:mm:ss',; && 日期时间格式
'G/通用格式')
ENDFOR
t1=SECONDS()
_DBF_EXCEL("C:\TEMP\test.xls", "测试表", @aFieldInfo, 20, 4, 1, "数 据 导 出 表", 2)
? SECONDS()-t1
RETURN
**
** DBF转EXCEL
** _DBF_EXCEL(cOutFile, cAlias, aFieldInfo, nPageRows, nStartRow, nStartCol, cTitle, nTitleRow)
** cOutFile 输出EXCEL文件名
** cAlias DBF表工作区别名
** aFieldInfo 字段信息,用AFIELDS()获取,可自定义栏目名、数据格式等。
** nPageRows 每页数据行数
** nStartRow 开始行
** nStartCol 开始列
** cTitle 标题
** nTitleRow 标题行
**
FUNCTION _DBF_EXCEL(cOutFile, cAlias, aFieldInfo, nPageRows, nStartRow, nStartCol, cTitle, nTitleRow)
LOCAL oExcel
oExcel = CREATEOBJECT("Excel.Application") && 创建电子表格
oExcel.DisplayAlerts = .F. && 关闭 Excle 提示对话框
oExcel.WorkBooks.Add && 创建工作簿
* 如果页数多了,删除多余的
LOCAL nPageCount
nPageCount = CEILING(RECCOUNT(cAlias)/nPageRows) && 页数
DO WHILE oExcel.Worksheets.Count > nPageCount
oExcel.Sheets[oExcel.Worksheets.Count].Select
oExcel.ActiveWindow.SelectedSheets.Delete
ENDDO
* 如果页数不够,添加
FOR i=oExcel.Worksheets.Count+1 TO nPageCount
oExcel.Sheets.Add
ENDFOR
* 页名
FOR i=1 TO nPageCount
oExcel.Sheets[i].Name = "第"+TRANSFORM(i)+"页"
ENDFOR
* 利用剪贴板把DBF内容复制到EXCEL表
SELECT (cAlias)
LOCAL nRow, nCol, nEndRow, nEndCol
nEndRow = nStartRow + nPageRows && 结束行,第1行为栏目行
nEndCol = nStartCol + ALEN(aFieldInfo,1) - 1 && 结束列
FOR i=1 TO nPageCount && 处理各页
WITH oExcel
* 打开页
.Sheets[i].Activate
* 标题格式设置
.Range(.Cells(nTitleRow,nStartCol), .Cells(nTitleRow,nEndCol)).Select
.Selection.NumberFormatLocal = "@" && 文本格式
.Selection.HorizontalAlignment = -4108 && 居中 xlCenter
.Selection.VerticalAlignment = -4108
.Selection.Merge && 合并单元格
* 栏目行格式设置
.Range(.Cells(nStartRow,nStartCol), .Cells(nStartRow,nEndCol)).Select
.Selection.NumberFormatLocal = "@"
.Selection.HorizontalAlignment = -4108 && 居中 xlCenter
.Selection.VerticalAlignment = -4108
* 各列数据格式设置
FOR nCol=nStartCol TO nEndCol
.Range(.Cells(nStartRow+1,nCol), .Cells(nEndRow,nCol)).Select
.Selection.NumberFormatLocal = aFieldInfo[nCol-nStartCol+1, 8]
ENDFOR
.Cells(nTitleRow,nStartCol).Value = cTitle && 标题
GO (i-1)*nPageRows + 1 && 每页第一行的数据记录位置
* 使用_VFP.DataToClip(),字符串第一个字符是双引号("),粘贴时可能会出现异常
* 自定义一个类似的函数 _DataToClip() 来处理(同时处理栏目行和备注字段)
_DataToClip(cAlias, @aFieldInfo, nPageRows) && 复制DBF记录
.Range(.Cells(nStartRow,nStartCol), .Cells(nEndRow,nEndCol)).Select
.ActiveSheet.Paste && 粘贴到EXCEL
.Cells(1,1).Select
.Columns.AutoFit && 自动适应行列宽
.Rows.AutoFit
ENDWITH
ENDFOR
oExcel.Sheets[1].Activate && 打开第1页
* 调试观察时用
** oExcel.ActiveWindow.WindowState = 2 && 最大化窗口
** oExcel.Caption = cTitle && Excel标题
** oExcel.Visible = .T.
** MESSAGEBOX("中断预览")
* 保存关闭
oExcel.ActiveWorkbook.SaveAs(cOutFile, -4143) && 另存, 常规工作簿格式,xlNormal:-4143
oExcel.Workbooks.Close && 关闭工作簿
oExcel.Quit && 关闭Excel
RELEASE oExcel && 释放oExcel
ENDFUNC
* DBF复制数据到剪贴板
* 数据格式:列分隔符为制表符,行分隔符为回车符
* "列1数据"制表符"列2数据"制表符 ...... 制表符"列n数据"回车符
FUNCTION _DataToClip(cAlias, aFieldInfo, nRecord)
SELECT (cAlias)
IF EOF()
RETURN .F.
ENDIF
LOCAL i, cMem
cMem = '"' + STRTRAN(aFieldInfo[1,7], '"', '""') + '"'
FOR i=2 TO ALEN(aFieldInfo,1)
cMem = cMem + 0h09 + '"' + STRTRAN(aFieldInfo[i,7], '"', '""') + '"'
ENDFOR
cMem = cMem + 0h0D
SCAN NEXT nRecord
cMem = cMem + _GetData(@aFieldInfo, 1)
FOR i=2 TO ALEN(aFieldInfo,1)
cMem = cMem + 0h09 + _GetData(@aFieldInfo, i)
ENDFOR
cMem = cMem + 0h0D
ENDSCAN
_CLIPTEXT = cMem
RETURN .T.
ENDFUNC
FUNCTION _GetData(aFieldInfo, nFieldNum)
LOCAL cMem
cMem = ICASE(;
aFieldInfo[nFieldNum,2]=="I", '"'+TRANSFORM(EVALUATE(aFieldInfo[nFieldNum,1]))+'"',;
INLIST(aFieldInfo[nFieldNum,2],"B","N","F"), '"'+;
LTRIM(STR(EVALUATE(aFieldInfo[nFieldNum,1]),aFieldInfo[nFieldNum,3],aFieldInfo[nFieldNum,4]))+'"',;
INLIST(aFieldInfo[nFieldNum,2],"C","V","W","M"), '"'+STRTRAN(EVALUATE(aFieldInfo[nFieldNum,1]),'"','""')+'"',;
aFieldInfo[nFieldNum,2]=="D", '"'+DTOC(EVALUATE(aFieldInfo[nFieldNum,1]))+'"',;
aFieldInfo[nFieldNum,2]=="T", '"'+TTOC(EVALUATE(aFieldInfo[nFieldNum,1]))+'"',;
'"'+TRANSFORM(EVALUATE(aFieldInfo[nFieldNum,1]))+'"')
RETURN cMem
ENDFUNC