Foxwx微信公众号管理软件---同心软件-DBF生成EXCEL文件

DBF生成EXCEL文件

DBF生成EXCEL文件未测试

DBF生成EXCEL文件

****************************************

* 生成EXCEL文件 *

* 许文远 1.0.1 2003.06.30 *

* 许文远 1.0 2003.06.28 *

*　　　　*

****************************************

FUNCTION ToExcel

LPARAMETERS ExcelFile,OutField,PageSet,OtherSet

*ExcelFile-生成的EXCEL文件名 (必需的参数)

*OutField-输出的字段列1-字段名列2-标题列3-宽度(=-1为自动) 列4-格式符 (可省略)

*PageSet-页面设置列1-设置的项目列2-设置的值 (可省略,PageSet的可用值请看程序)

*OtherSet-其它设置 (可省略,OtherSet的可用值请看程序)

*使用本函数之前,请先切换到要输出的工作区;其次只支持字段,不支持表达式

*字段也不支持备注型和通用型

*如果用户正在使用EXCEL编辑同名的文件,或者将要生成的EXCEL文件被占用

*也会造成程序出错,使用本函数之前建议关闭EXCEL

DO CASE

CASE PARAMETERS()=1

STORE null TO OutField,PageSet,OtherSet

CASE PARAMETERS()=2

STORE null TO PageSet,OtherSet

CASE PARAMETERS()=3

STORE null TO OtherSet

ENDCASE

LOCAL i,OutFields,ExcelApp,ExcelAppRang

FOR i=1 TO IIF(TYPE("OutField(1)")="U" OR ISNULL(OutField),0,ALEN(OutField,1))

OutField(i,1)=UPPER(ALLTRIM(OutField(i,1)))

FOR i=1 TO IIF(TYPE("PageSet(1)")="U" OR ISNULL(PageSet),0,ALEN(PageSet,1))

PageSet(i,1)=UPPER(ALLTRIM(PageSet(i,1)))

FOR i=1 TO IIF(TYPE("OtherSet(1)")="U" OR ISNULL(OtherSet),0,ALEN(OtherSet,1))

OtherSet(i,1)=UPPER(ALLTRIM(OtherSet(i,1)))

OutFields=""

FOR i=1 TO IIF(TYPE("OutField(1)")="U" OR ISNULL(OutField),0,ALEN(OutField,1))

OutFields=OutFields+IIF(EMPTY(OutFields),"",",")+OutField(i,1)

IF ISNULL(OutField) OR OutField(1)="AUTO_SET" AND OutField(2)="-1" &&生成EXCEL文件

COPY TO (ExcelFile) XL5

ELSE

COPY TO (ExcelFile) FIELDS &OutFields XL5

ENDIF

ExcelApp=CREATEOBJECT("Excel.application") &&访问EXCEL

If Type("ExcelApp")#"O"

WAIT CLEAR

MessageBox( "访问Excel失败！请检查你的系统是否正确安装 Excel 软件！"+CHR(13)+CHR(13)+;

"但已经生成未带格式的 Excel 文件:"+ExcelFile,48,"Excel不正常")

RETURN .f.

ENDIF

ExcelApp.Visible =.f.

ExcelApp.Caption ="生成EXCEL" &&标题

ExcelApp.Workbooks.Open(ExcelFile) &&打开文件

ExcelApp.Workbooks(1).ActiveSheet.Name="Test" &&工作表名

ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).PageSetup &&页面设置对象

FOR i=1 TO IIF(TYPE("PageSet(1)")="U" OR ISNULL(PageSet),0,ALEN(PageSet,1))

DO CASE

CASE PageSet(i,1)=UPPER("PaperSize") &&纸张类型

ExcelAppRang.PaperSize=PageSet(i,2)

CASE PageSet(i,1)=UPPER("Orientation") &&打印方向

ExcelAppRang.Orientation=PageSet(i,2)

CASE PageSet(i,1)=UPPER("TopMargin") &&页顶空

ExcelAppRang.TopMargin=PageSet(i,2)

CASE PageSet(i,1)=UPPER("BottomMargin") &&页底空

ExcelAppRang.BottomMargin=PageSet(i,2)

CASE PageSet(i,1)=UPPER("LeftMargin") &&页左空

ExcelAppRang.LeftMargin=PageSet(i,2)

CASE PageSet(i,1)=UPPER("RightMargin") &&页右空

ExcelAppRang.RightMargin=PageSet(i,2)

CASE PageSet(i,1)=UPPER("HeaderMargin") &&页眉位置

ExcelAppRang.HeaderMargin=PageSet(i,2)

CASE PageSet(i,1)=UPPER("FooterMargin") &&页脚位置

ExcelAppRang.FooterMargin=PageSet(i,2)

CASE PageSet(i,1)=UPPER("PrintTitleRows") &&行标题

ExcelAppRang.PrintTitleRows=PageSet(i,2)

CASE PageSet(i,1)=UPPER("PrintTitleColumns") &&列标题

ExcelAppRang.PrintTitleColumns=PageSet(i,2)

CASE PageSet(i,1)=UPPER("LeftHeader") &&左页眉

ExcelAppRang.LeftHeader=PageSet(i,2)

CASE PageSet(i,1)=UPPER("CenterHeader") &&中页眉

ExcelAppRang.CenterHeader=PageSet(i,2)

CASE PageSet(i,1)=UPPER("RightHeader") &&右页眉

ExcelAppRang.RightHeader=PageSet(i,2)

CASE PageSet(i,1)=UPPER("LeftFooter") &&左页脚

ExcelAppRang.LeftFooter=PageSet(i,2)

CASE PageSet(i,1)=UPPER("CenterFooter") &&中页脚

ExcelAppRang.CenterFooter=PageSet(i,2)

CASE PageSet(i,1)=UPPER("RightFooter") &&右页脚

ExcelAppRang.RightFooter=PageSet(i,2)

CASE PageSet(i,1)=UPPER("CenterHorizontally") &&页面水平居中

ExcelAppRang.CenterHorizontally=PageSet(i,2)

CASE PageSet(i,1)=UPPER("CenterVertically") &&页面垂直居中

ExcelAppRang.CenterVertically=PageSet(i,2)

ENDCASE

IF ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1"

FOR i=1 TO FCOUNT()

IF !ISNULL(OutField) AND ASCAN(OutField,UPPER(FIELD(i)))>0

ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,i).value=OutField(ASCAN(OutField,UPPER(FIELD(i)))+1) &&标题

*IF !ISNULL(OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)) AND TYPE("OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)")="N" AND OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)#-1

* ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth =OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)

*ENDIF

IF !ISNULL(OutField(ASCAN(OutField,UPPER(FIELD(i)))+3)) AND !EMPTY(OutField(ASCAN(OutField,UPPER(FIELD(i)))+3)) &&格式模版

ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).NumberFormatLocal=OutField(ASCAN(OutField,UPPER(FIELD(i)))+3)

ENDIF

ELSE

FOR i=1 TO ALEN(OutField,1)

IF !ISNULL(OutField(i,2)) AND !EMPTY(OutField(i,2)) &&标题名称

ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,i).value=OutField(i,2)

ENDIF

*IF !ISNULL(OutField(i,3)) AND TYPE("OutField(i,3)")="N" AND OutField(i,3)#-1 &&列宽

* ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth =OutField(i,3)

*ENDIF

IF !ISNULL(OutField(i,4)) AND !EMPTY(OutField(i,4)) &&格式模版

ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).NumberFormatLocal=OutField(i,4)

ENDIF

IF ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1" &&选择标题行范围

ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;

ExcelApp.Workbooks(1).Sheets(1).Application.Cells( 1,FCOUNT()))

ELSE

ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;

ExcelApp.Workbooks(1).Sheets(1).Application.Cells( 1,ALEN(OutField,1)))

ENDIF

ExcelAppRang.HorizontalAlignment=3 &&水平居中

ExcelAppRang.VerticalAlignment=2 &&垂直居中

ExcelAppRang.Font.Bold = .t.

IF ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1" &&选择表格范围

ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;

ExcelApp.Workbooks(1).Sheets(1).Application.Cells(RECCOUNT()+1,FCOUNT()))

ELSE

ExcelAppRang=ExcelApp.Workbooks(1).Sheets(1).Application.Range(ExcelApp.Workbooks(1).Sheets(1).Application.Cells(1,1),;

ExcelApp.Workbooks(1).Sheets(1).Application.Cells(RECCOUNT()+1,ALEN(OutField,1)))

ENDIF

IF !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("FontSize"))#0 &&字体大小

ExcelAppRang.Font.Size=OtherSet(ASCAN(OtherSet,UPPER("FontSize"))+1)

ELSE

ExcelAppRang.Font.Size=10

ENDIF

IF !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("FontName"))#0 &&字体

ExcelAppRang.Font.Name=OtherSet(ASCAN(OtherSet,UPPER("FontName"))+1)

ELSE

ExcelAppRang.Font.Name="宋体"

ENDIF

IF !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("LineStyle"))#0 &&表格线的类型

STORE OtherSet(ASCAN(OtherSet,UPPER("LineStyle"))+1) TO

ExcelAppRang.Borders(1).LineStyle,;

ExcelAppRang.Borders(2).LineStyle,;

ExcelAppRang.Borders(3).LineStyle,;

ExcelAppRang.Borders(4).LineStyle

ELSE

STORE 1 TO

ExcelAppRang.Borders(1).LineStyle,;

ExcelAppRang.Borders(2).LineStyle,;

ExcelAppRang.Borders(3).LineStyle,;

ExcelAppRang.Borders(4).LineStyle

ENDIF

IF !ISNULL(OtherSet) AND TYPE("OtherSet(1)")#"U" AND ASCAN(OtherSet,UPPER("Weight"))#0 &&表格线的宽度,当LineStyle=1时有效

STORE OtherSet(ASCAN(OtherSet,UPPER("Weight"))+1) TO

ExcelAppRang.Borders(1).Weight,;

ExcelAppRang.Borders(2).Weight,;

ExcelAppRang.Borders(3).Weight,;

ExcelAppRang.Borders(4).Weight

ELSE

STORE 2 TO

ExcelAppRang.Borders(1).Weight,;

ExcelAppRang.Borders(2).Weight,;

ExcelAppRang.Borders(3).Weight,;

ExcelAppRang.Borders(4).Weight

ENDIF

IF ISNULL(OutField) OR UPPER(OutField(1))="AUTO_SET" AND OutField(2)="-1" &&列宽

FOR i=1 TO FCOUNT()

IF !ISNULL(OutField) AND ASCAN(OutField,UPPER(FIELD(i)))>0 and OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)#-1

ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth =OutField(ASCAN(OutField,UPPER(FIELD(i)))+2)

ELSE

ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).AutoFit

ENDIF

ELSE

FOR i=1 TO ALEN(OutField,1)

IF OutField( i, 3)=-1

ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).AutoFit

ELSE

ExcelApp.Workbooks(1).Sheets(1).Application.Columns(i).ColumnWidth=OutField( i, 3)

ENDIF

ExcelApp.Workbooks(1).Save() &&保存

ExcelApp.Quit &&关闭

RELEASE ExcelApp,ExcelAppRang

RETURN .t.