以下是引用wengjl在2021-3-26 15:39:18的发言:
你的另一种想法
不需要生成BB.XLS。只要打开模板,然后将AA.DBF中的数据一个一个写入即可。最后将模板表另存为…
你的另一种想法
不需要生成BB.XLS。只要打开模板,然后将AA.DBF中的数据一个一个写入即可。最后将模板表另存为…
试了一下,从数组中一个个读入,可以读取备注内容,但速度慢很多。字符串后面的空格还是存在。能不能不一条条,而是批量读取?
[此贴子已经被作者于2021-3-27 16:48编辑过]
CLOSE DATABASES ALL SELECT * FROM a INTO CURSOR cx READWRITE * 修改字符型字段的宽度 FOR lnj = 1 TO FCOUNT() lc1 = FIELD(lnj) IF TYPE(lc1) == "C" CALCULATE MAX(LEN(ALLTRIM(&lc1))) TO ARRAY arr ALTER table cx alter &lc1 c(arr[1]) ENDIF ENDFOR ERASE 查询结果.XLSX _VFP.DataToClip("cx", RECCOUNT(), 3) oExcel = CreateObject("Excel.Application") WITH oExcel .WorkBooks.Open(SYS(5) + SYS(2003) + "\表头模板.xlsx") .ActiveSheet.Cells(3, 1).PasteSpecial .ActiveSheet.Rows[3].Delete SELECT cx SCAN .ActiveSheet.Cells(2 + RECNO(), FCOUNT() - 1). Value = bz .ActiveSheet.Cells(2 + RECNO(), FCOUNT()). Value = ckxx ENDSCAN .DisplayAlerts = .F. .ActiveWorkbook.Saveas(SYS(5) + SYS(2003) + "\查询结果.XLSX", 51) .ActiveWorkbook.Close .DisplayAlerts = .T. ENDWITH IF FILE("查询结果.XLSX") MESSAGEBOX("EXCEL文件生成成功") ENDIF
CLOSE DATABASES ALL t1 = SECONDS() SELECT * FROM a INTO CURSOR cx READWRITE * 修改字符型字段的宽度 FOR lnj = 1 TO FCOUNT() lc1 = FIELD(lnj) IF TYPE(lc1) == "C" CALCULATE MAX(LEN(ALLTRIM(&lc1))) TO ARRAY arr ALTER table cx alter &lc1 c(arr[1]) ENDIF ENDFOR * 把BZ、CKXX 备注字段的内容保存在字符串中 lc1 = "" SCAN lc1 = lc1 + ALLTRIM(bz) + CHR(9) + ALLTRIM(ckxx) + CHR(13) + CHR(10) ENDSCAN ERASE 查询结果.XLSX GO TOP _VFP.DataToClip("cx", RECCOUNT(), 3) oExcel = CreateObject("Excel.Application") WITH oExcel .WorkBooks.Open(SYS(5) + SYS(2003) + "\表头模板.xlsx") .ActiveSheet.Cells(3, 1).PasteSpecial _CLIPTEXT = lc1 .ActiveSheet.Cells(4, FCOUNT() - 1).PasteSpecial _CLIPTEXT = "" .ActiveSheet.Rows[3].Delete .DisplayAlerts = .F. .ActiveWorkbook.Saveas(SYS(5) + SYS(2003) + "\查询结果.XLSX", 51) .ActiveWorkbook.Close .DisplayAlerts = .T. ENDWITH MESSAGEBOX(SECONDS() - t1) IF FILE("查询结果.XLSX") MESSAGEBOX("EXCEL文件生成成功") ENDIF
CLOSE DATABASES ERASE cx.txt ERASE 查询结果.XLSX t1 = SECONDS() USE a IN 0 * 生成字段列表 lcStr = "" FOR lnj = 1 TO FCOUNT() - 2 lcStr = lcStr + "," + FIELD(lnj) ENDFOR lcStr = SUBSTR(lcStr, 2) USE IN a SELECT * FROM a INTO CURSOR cx READWRITE * 修改字符型字段的宽度 FOR lnj = 1 TO FCOUNT() lc1 = FIELD(lnj) IF TYPE(lc1) == "C" CALCULATE MAX(LEN(ALLTRIM(&lc1))) TO ARRAY arr ALTER table cx alter &lc1 c(arr[1]) ENDIF ENDFOR COPY TO cx.txt FIELDS &lcStr DELIMITED WITH "" WITH CHARACTER TAB ALL * 把BZ、CKXX 备注字段的内容保存在字符串中 lc1 = "" SCAN lc1 = lc1 + ALLTRIM(bz) + CHR(9) + ALLTRIM(ckxx) + CHR(13) + CHR(10) ENDSCAN oExcel = CreateObject("Excel.Application") WITH oExcel .WorkBooks.Open(SYS(5) + SYS(2003) + "\表头模板.xlsx") _CLIPTEXT = FILETOSTR("cx.txt") .ActiveSheet.Cells(3, 1).PasteSpecial _CLIPTEXT = lc1 .ActiveSheet.Cells(3, FCOUNT() - 1).PasteSpecial _CLIPTEXT = "" .DisplayAlerts = .F. .ActiveWorkbook.Saveas(SYS(5) + SYS(2003) + "\查询结果.XLSX", 51) .ActiveWorkbook.Close .DisplayAlerts = .T. ENDWITH MESSAGEBOX(SECONDS() - t1) IF FILE("查询结果.XLSX") MESSAGEBOX("EXCEL文件生成成功") ENDIF