在VFP中,怎么样将一张DBF表转为EXCEL的XSL表?
发布网友
发布时间：2022-07-08 00:57
共1个回答
热心网友
时间：2022-07-14 11:24
另外提供一些以编程方式将DBF导成XSL的程式及相关资料，希望对你有用：
VFP导成XLS&& DbfToExcel.PRG
&& 记得要安装Excel啊，否则不好用
CLOSE DATABASES ALL
SET DATE YMD
SET CENTURY ON
cDbfFile = GETFILE("dbf")
IF EMPTY(cDbfFile)
RETURN
ENDIF
USE (cDbfFile) ALIAS FoxTable IN 0
IF NOT USED("FoxTable")
=MESSAGEBOX("打开表失败，程序将中止！", 16, "Error")
RETURN
ENDIF
cExcelFile = PUTFILE("保存为(&N):",JUSTSTEM(cDbfFile)+".xls","xls")
IF EMPTY(cExcelFile)
CLOSE DATABASES ALL
RETURN
ENDIF
SELECT FoxTable
oExcelSheet = GETOBJECT("","Excel.Sheet") && 产生Excel对象
IF NOT TYPE("oExcelSheet") = "O"
=MESSAGEBOX("Excel对象创建失败，程序将中止！", 16, "Error")
RETURN
ENDIF
oExcelApp = oExcelSheet.Application
oExcelApp.Workbooks.Add()
oExcelApp.ActiveWindow.WindowState=2
oSheet = oExcelApp.ActiveSheet
nFldCount = AFIELDS(aFldList, "FoxTable")
FOR i = 1 TO nFldCount
oSheet.Cells(1,i).Value = aFldList[i, 1]
ENDFOR
cRecc = STR(RECCOUNT("FoxTable"))
SCAN
WAIT WINDOW ALLTRIM(STR(RECNO())) + "/" + cRecc NOWAIT
FOR i = 1 TO nFldCount
vValue = .NULL.
IF AT(aFldList[i, 2], "CDLMNFIBYT") = 0
LOOP
ENDIF
cFldName = aFldList[i, 1]
vValue = EVALUATE(cFldName)
DO CASE
CASE aFldList[i, 2] = "C" && 字符/字符串
vValue = TRIM(vValue)
CASE aFldList[i, 2] = "D" && 日期
vValue = DTOC(vValue)
CASE aFldList[i, 2] = "T" && 日期时间
vValue = TTOC(vValue)
CASE INLIST(aFldList[i, 2], "N", "F", "I", "B", "Y") && 数值
CASE aFldList[i, 2] = "L" && 逻辑
CASE aFldList[i, 2] = "M" && 备注型
OTHERWISE
vValue = .NULL.
ENDCASE
IF VARTYPE(vValue) = "C" AND EMPTY(vValue)
LOOP
ENDIF
IF NOT ISNULL(vValue)
oSheet.Cells(RECNO("FoxTable")+1, i).Value = vValue
ENDIF
ENDFOR
ENDSCAN
cChrStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
FOR i = 1 TO nFldCount
cColumn = SUBSTR(cChrStr, INT((i-1)/26), 1) + SUBSTR(cChrStr, IIF(MOD(i, 26)= 0, 26, MOD(i, 26)) , 1)
oSheet.Columns(cColumn + ":" + cColumn).ColumnWidth = 12
IF aFldList[i, 2] = "M"
oSheet.Columns(cColumn + ":" + cColumn).WrapText = .F.
ENDIF
ENDFOR
oExcelApp.ActiveWorkbook.SaveAs(cExcelFile)
oExcelApp.ActiveWorkbook.Close(.F.)
oExcelApp.ActiveWorkbook.Close(.F.)
oExcelApp.Quit
oExcelSheet = .NULL.
oExcelApp = .NULL.
WAIT CLEAR
=MESSAGEBOX("转换完毕！", 64, "OK")
CLOSE DATABASES ALL
程序是用VFP8写的，在VFP6中也可以，没有问题。只要能够执行完成，就会是正确的，行数只受你安装的Excel最大行数*，至少大于65535行
这个程序支持所有字段类型，包括MEMO类型字段。
在VFP中全面控制Excel VFP和Excel都可以用来进行处理数据库表格，如果巧妙地将二者的优点结合起来，将会大大方便我们的工作。比如我们可以利用VFP进行处理数据，而利用Excel的预览打印功能进行报表打印。这就需要我们在VFP中直接来控制Excel。下面就在开发VFP应用项目时对Excel的控制作一下介绍：
1．创建Excel对象
eole=CREATEOBJECT(′Excel.application′)
2．添加新工作簿
eole.Workbooks.add
3．设置第3个工作表为激活工作表
eole.Worksheets(〃sheet3〃).Activate
4．打开指定工作簿
eole.Workbooks.Open(〃c:\temp\ll.xls〃)
5．显示Excel窗口
eole.visible=.t.
6．更改Excel标题栏
eole.Caption=〃VFP应用程序调用Microsoft Excel〃
7．给单元格赋值
eole.cells(1,4).value=XM(XM为数据库字段名)
8．设置指定列的宽度(单位：字符个数)
eole.ActiveSheet.Columns(1).ColumnWidth=5
9．设置指定行的高度(单位：磅)
eole.ActiveSheet.Rows(1).RowHeight=1/0.035
(设定行高为1厘米，1磅=0.035厘米)
10．在第18行之前插入分页符
eole.Worksheets(〃Sheet1〃).Rows(18).PageBreak=1
11．在第4列之前删除分页符
eole.ActiveSheet.Columns(4).PageBreak=0
12．指定边框线宽度(Borders参数如下)
ole.ActiveSheet.Range(〃b3:d3〃).Borders(2).Weight=3
13．设置四个边框线条的类型
eole.ActiveSheet.Range(〃b3:d3〃).Borders(2).LineStyle=1
(其中Borders参数：1－左、2－右、3－顶、4－底、5－斜、6－斜/；LineStyle值：1与7－细实、2－细虚、4－点虚、9－双细实线)
14．设置页眉
eole.ActiveSheet.PageSetup.CenterHeader=〃报表1〃
15．设置页脚
eole.ActiveSheet.PageSetup.CenterFooter=〃第＆P页〃
16．设置页眉到顶端边距为2厘米
eole.ActiveSheet.PageSetup.HeaderMargin=2/0.035
17．设置页脚到底边距为3厘米
eole.ActiveSheet.PageSetup.FooterMargin=3/0.035
18．设置顶边距为2厘米
eole.ActiveSheet.PageSetup.TopMargin=2/0.035
19．设置底边距为4厘米
eole.ActiveSheet.PageSetup.BottomMargin=4/0.035
20．设置左边距为2厘米
veole.ActiveSheet.PageSetup.LeftMargin=2/0.035
21．设置右边距为2厘米
eole.ActiveSheet.PageSetup.RightMargin=2/0.035
22．设置页面水平居中
eole.ActiveSheet.PageSetup.CenterHorizontally=.t.
23．设置页面垂直居中
eole.ActiveSheet.PageSetup.CenterVertically=.t.
24．设置页面纸张大小(1－窄行8 5 11 39－宽行14 11)
eole.ActiveSheet.PageSetup.PaperSize=1
25．打印单元格网线
eole.ActiveSheet.PageSetup.PrintGridlines=.t.
26．拷贝整个工作表
eole.ActiveSheet.UsedRange.Copy
27．拷贝指定区域
eole.ActiveSheet.Range(〃A1:E2〃).Copy
28．粘贴
eole.WorkSheet(〃Sheet2〃).Range(〃A1〃).PasteSpecial
29．在第2行之前插入一行
eole.ActiveSheet.Rows(2).Insert
30．在第2列之前插入一列
eole.ActiveSheet.Columns(2).Insert
31．设置字体
eole.ActiveSheet.Cells(2,1).Font.Name=〃黑体〃
32．设置字体大小
eole.ActiveSheet.Cells(1,1).Font.Size=25
33．设置字体为斜体
eole.ActiveSheet.Cells(1,1).Font.Italic=.t.
34．设置整列字体为粗体
eole.ActiveSheet.Columns(1).Font.Bold=.t.
35．清除单元格公式
eole.ActiveSheet.Cells(1,4).ClearContents
36．打印预览工作表
eole.ActiveSheet.PrintPreview
37．打印输出工作表
eole.ActiveSheet.PrintOut
38．工作表另为
eole.ActiveWorkbook.SaveAs(〃c:\temp\22.xls〃)
39．放弃存盘
eole.ActiveWorkbook.saved=.t.
40．关闭工作簿
eole.Workbooks.close
41．退出Excel
eole.quit
以上控制调用语句在中文VFP5.0企业版下运行通过，运行环境为Excel 97及中文Windows 98。
Grid转Excel的类
*------------------------------------*
rex1105
************
*****转excel类，编写日期:2006-05-23 By Rex1105
********
PARAMETERS oGrid,cHeader
IF PARAMETERS()<2
Return .F.
ENDIF
cRec=ALLTRIM(oGrid.RECORDSOURCE)
Select ALIAS(cRec)
FILE_NAME=PUTFILE("","","XLS")
IF EMPTY(FILE_NAME)
Return .F.
ENDIF
***检查是否有安装office软件***
excelsheet=GETOBJECT("","excel.sheet")
IF TYPE("excelsheet")#"O"
MESSAGEBOX("您没有安装office办公软件!",16,"信息提示")
RELEASE excelsheet
Return .F.
ENDIF
****检查文件有无打开*****
LOCAL loldsetopt,mChanNum,nWS
nWs=2
loldsetopt=DDESETOPTION("safety")
=DDESETOPTION("safety",.F.)
mChanNum=DDEINITIATE("excel",'&file_NAME')
IF <>mChanNum-1
MESSAGEBOX("有同名的Excel文件打开!请先关闭它!",64,"信息提示")
=DDETERMINATE(mChanNum)
=DDESETOPTION("safety",loldsetopt)
Return .F.
ELSE
=DDETERMINATE(mChanNum)
=DDESETOPTION("safety",loldsetopt)
ENDIF
LOCAL cCopy,oexl
DIMENSION [oGrid.ColumnCount,2]dColumn
FOR i=1 TO oGrid.COLUMNCOUNT
FOR ii=1 TO oGrid.COLUMNCOUNT
nOrder=oGrid.COLUMNS(ii).COLUMNORDER
IF nOrder=i
[i,1]dColumn=oGrid.COLUMNS(ii).header1.CAPTION
[i,2]dColumn=oGrid.COLUMNS(ii).CONTROLSOURCE
EXIT
ENDIF
ENDFOR
ENDFOR
****建立输出文件*****
cCopy=""
FOR i=1 TO ALEN(dColumn,1)
cCopy=cCopy+[i,2]dColumn+","
NEXT
cCopy=LEFT(cCopy,LEN(cCopy)-1)
cCopy="COPY TO "+'"'+FILE_NAME+'"'+" TYPE XL5 FIELDS "+cCopy
&cCopy
&&建立excel表，并写表头
oexl=CREATEOBJECT("excel.APPLICATION")
WITH oexl
.workbooks.OPEN(FILE_NAME)
.VISIBLE=.T.
.cells.Select
.Selection.FONT.Size=10
ENDWITH
Select ALIAS(cRec)
=AFIELDS(cField,cRec)
****第一行加中文标题*****
FOR i=1 TO ALEN(dColumn,1)
oexl.cells(1,i).VALUE=[i,1]dColumn
****每列数据处理，分字符与数值日期*****
DO CASE
CASE TYPE([i,2]dColumn)="N"
***查找数值的小数位****
FOR ii=1 TO ALEN(cField,1)
IF UPPER([i,2]dColumn)=UPPER(cRec)+"."+[ii,1]cField
nWS=[ii,4]cField
EXIT
ENDIF
NEXT
oexl.COLUMNS(retuabc(i)+":"+retuabc(i)).NumberFormatLocal = "#,##0."+REPLICATE("0",nWs)+"_);[红色](#,##0."+REPLICATE("0",nWs)+")"
CASE TYPE([i,2]dColumn)="D" OR TYPE([i,2]dColumn)="T"
oexl.COLUMNS(retuabc(i)+":"+retuabc(i)).NumberFormatLocal = "yyyy/mm/dd"
ENDCASE
NEXT
****表格线****
oexl.RANGE("A1:"+retuabc(ALEN(dColumn,1))+ALLTRIM(Str(RECCOUNT()+1))).Select
oexl.Selection.BorderS(5).LineStyle = -4142
oexl.Selection.BorderS(6).LineStyle = -4142
WITH oexl.Selection.BorderS(7)
.LineStyle =1
.Weight = 2
.ColorIndex = -4105
ENDWITH
WITH oexl.Selection.BorderS(8)
.LineStyle =1
.Weight = 2
.ColorIndex =-4105
ENDWITH
WITH oexl.Selection.BorderS(9)
.LineStyle =1
.Weight = 2
.ColorIndex = -4105
ENDWITH
WITH oexl.Selection.BorderS(10)
.LineStyle =1
.Weight = 2
.ColorIndex = -4105
ENDWITH
WITH oexl.Selection.BorderS(11)
.LineStyle =1
.Weight = 1
.ColorIndex = -4105
ENDWITH
WITH oexl.Selection.BorderS(12)
.LineStyle =1
.Weight = 1
.ColorIndex = -4105
ENDWITH
***第一行显示灰色加粗体****
WITH oexl.RANGE("A1:"+retuabc(ALEN(dColumn,1))+"1")
.HorizontalAlignment=3
.VerticalAlignment = 2
.WrapText = .T.
.FONT.bold=.T.
.Interior.ColorIndex = 40
ENDWITH
oexl.Rows("1:1").Select
oexl.Selection.INSERT
oexl.Selection.INSERT
oexl.Selection.INSERT
&&抬头
WITH oexl.RANGE("A1:"+retuabc(ALEN(dColumn,1))+"1")
.merge
.VALUE=cHeader
.FONT.Size=14
.HorizontalAlignment=3
.VerticalAlignment=2
.FONT.bold=.T.
ENDWITH
&&加报表时间
WITH oexl.RANGE("A2:d2")
.merge
.VALUE="报表时间："+TTOC(DATETIME())
ENDWITH
&&加表格第一列
oexl.cells.Select
oexl.Selection.COLUMNS.AUTOFIT()
RELEASE oexl
Return .T.
参考资料：http://hi.baidu.com/443124089
