各部门电子表格要汇总，VFP一个类库轻松搞定，告别加班

　“人家天天要加班啦，表格都做不完啦，你等于接我嘛！”码农小张正在努力的码代码，突然传来了小丽的俏丽的声音。　　

     想着今天经理给小丽下达的每天都要汇总疫情的体温上报数据，这工作说简单也简单，就是汇总表格，说复杂也是，光部门的文档就有十几个，每个部门的格式都还会弄错乱。办公室小丽最近都要汇总好多表格，小张看着于心不忍，于是想着着给她减重一下负担。

　　于是花了一个时候开发了EXCEL导入成表的功能，调用代码很简单，速度极快。　　

lcfile=Getfile("XLS,XLSX")If !File(lcfile)  Wait "文件不存在" Windows  Return .F.Endifxx=Createobject("importexcel")xx.cursorstruc="客户名称 c(50),产品名称 c(254),客户编码 c(20),完成时间 T ,备注 c(20),导入时间 T(8)"**以下两行也可以改成xx.improt(lcfile,"tmpxxx")xx.Alias="tmpxxx"xx.Import(lcfile)brow

导出EXCEL模板和把数据生成EXCEL表格也简单

*--导出模板文件*xx.templatetoxls()*--导出临时表*xx.toexcel("tmpxxx")

然后包装了一个表单，打包成了EXE，当小张把程序拿给小丽的时候，小丽顿时超级开心，当时眼睛里面闪着星星：“写程序很辛苦吧，不然我请你吃顿饭？”

小张蛮不在乎地说，就一小时，我轻飘飘地就做完了，小丽说：“大神这么厉害啊。那个，我男朋友来接我了，我先走了哈。”

小张目送小丽离开，又坐到了自己的座位上，好不开心，估计今晚做梦也比较香了。

类库送给大家，特点是导入超快。

Define Class importExcel As Custom  cursorstruc=""  Alias=""  filename=""  *-- 参数文件和临时表  Procedure Import  Lparameters cFile,cAlias  This.filename=cFile  If !Empty(cAlias)    This.Alias=cAlias  Endif
  If Empty(This.Alias)    Error "请设置临时表属性"  Endif  Local ox  oldtable=Select()  If !File(This.filename)    Error "文件不存在"  Endif
  ox = Createobject("Excel.Application")  ox.workbooks.Open(cFile)  lnrow = ox.activesheet.usedrange.Rows.Count  lncol = ox.activesheet.usedrange.Columns.Count  Public laxls  Dimension laxls(lnrow,lncol)  laxls = ox.activesheet.usedrange.Value  ox.Quit()  &&创建临时表  If Used(This.Alias)    Select (This.Alias)    Use  Endif  TEXT TO lccmd NOSHOW TEXTMERGE  create CURSOR <<this.alias>>(<<this.cursorstruc>>)  ENDTEXT  EXECSCRIPT(lccmd)  &&可以支持多行分号语法  *SELECT (this.alias)  lcFieldList=""  *lnsec=Seconds()  *--算法1  *只要EXCEL表格第一行为字段就可以了，顺序可以不一样  llismemo=.F.  &&查找是否有备注字段  Dimension atmp[Alen(laxls,2)] &&定义要删除的数组  For i=1 To Alen(laxls,2)  &&循环数组的列数    llfind=.F.    For j=1 To Fcount(This.Alias) &&循环验证字段名称      If Transform(UPPER(laxls(1,i)))=Alltrim(UPPER(Field(j)))  &&如果验证成功，就添加字段名称        If Type(Field(j))="M"          llismemo=.T.        Endif        lcFieldList=lcFieldList+","+Transform(laxls(1,i))        llfind=.T.        Exit      Endif    Next    If llfind=.F.      atmp[i]=.T.    Endif  Next  For i=Alen(atmp) To 1 Step -1    If atmp[i]      Adel(laxls,i,2)    Endif  Next
  lcFieldList=Right(lcFieldList,Len(lcFieldList)-1)  *ADEL(laxls,1) &&删除第一行数组   SELECT (this.alias)  If llismemo &&是否有备注字段        For i=1 To Alen(laxls,1)      Dimension atmp2(Alen(laxls,2))      For j=1 To Alen(laxls,2)        atmp2[j]=laxls[i,j]      Next      Append Blank      Gather From atmp2 Fields &lcFieldList Memo    Next  Else    lccmd="APPEND FROM ARRAY laxls fields "+lcFieldList+" "        &lccmd  Endif
  *?"时间",Seconds()-lnsec  SELECT(this.alias)  lcTable=this.alias  SELECT * FROM &lcTable WHERE RECNO()>1 INTO CURSOR &lcTable readwrite  *a1=b1*!*    Go Top*!*    Delete  Select (oldtable)  RETURN _TALLY  Endproc
PROCEDURE Templatetoxls  &&创建临时表  cName=SYS(2015)  TEXT TO lccmd NOSHOW TEXTMERGE  create CURSOR <<cName>> (<<this.cursorstruc>>)  ENDTEXT  EXECSCRIPT(lccmd)  &&可以支持多行分号语法  this.toexcel(cName)   USE IN (cName)     ENDPROC 
Function toexcel()  Lparameters dbfname  Declare Integer ShellExecute In shell32.Dll Integer HWnd,String lpszOP,String lpszFile,String lpszParams,String lpszDir,Integer fsshowcmd  *  RPTSHEET=Getobject('','excel.sheet')  RPTSHEET=Createobject("excel.application")  RPTSHEET.Visible=.F.  XLAPP=RPTSHEET.Application  XLAPP.WORKBOOKS.Add()  XLSHEET=XLAPP.ACTIVESHEET  RPTSHEET.Caption=dbfname+"_QiyuSoft"
  *!* 20．设置页脚、顶边距、底边距、左边距、右边距  With RPTSHEET.ACTIVESHEET.PageSetup    .CenterFooter="第&P页"    .TopMargin=1/0.035    .BottomMargin=2/0.035    .LeftMargin=1/0.035    .RightMargin=1/0.035  Endwith
  Select &dbfname  ** 创建报表头  gnFieldcount = Afields(gaMyArray)  && 创建数组。  For nCount = 1 To gnFieldcount    XLAPP.CELLS(1,nCount).Value=gaMyArray(nCount,1)    If Vartype(gaMyArray(nCount,1))='C'      RPTSHEET.Columns(nCount).Select      RPTSHEET.Selection.NumberFormatLocal = "@"  &&设置列格式为字符型    Else      RPTSHEET.Columns(nCount).Select      RPTSHEET.Selection.HorizontalAlignment=4  &&其它类型右对齐    Endif    RPTSHEET.ACTIVESHEET.Columns(nCount).Font.Size=9  Endfor
  Select &dbfname  Go Top  lccont=2 && 数据从第二行开始  Scan    For nCount = 1 To gnFieldcount      &&判断单元格里是否为字符型，如果是则去掉前后空格 排版需要。      &&上面是判断字段类型，这次判断 字段值类型      If Vartype(&gaMyArray(nCount,1))='C'        XLAPP.CELLS(lccont,nCount).Value=Alltrim(&gaMyArray(nCount,1))      Else        XLAPP.CELLS(lccont,nCount).Value=TRANSFORM(&gaMyArray(nCount,1))      Endif    Endfor    lccont=lccont+1  Endscan  RPTSHEET.CELLS.EntireColumn.AutoFit  && 自动宽度  *  WAIT CHR(gnFieldcount+64)+ALLTRIM(STR(lccont)) windows  **   设置表格边线  With RPTSHEET.ACTIVESHEET.Range("a1:"+Chr(gnFieldcount+64)+Alltrim(Str(lccont-1)))    *    .BorderS(2).LineStyle=9    .BorderS(1).Weight=2    .BorderS(2).Weight=2    .BorderS(3).Weight=2    .BorderS(4).Weight=2  Endwith  RPTSHEET.Visible=.T.    RPTSHEET.Cells(1,1).SelectENDFUNC
Enddefine

学习VFP，学习猫框

最关键是要告别　习得性无助

群里面有位狐友，问怎么导入EXCEL，我告诉他有个Importexcel类，他看也没有看，直接说不知道咋用。我只能说，你打开这个类，看看就明白了。

学东西，保持一点好奇心。

其实写类的好处：

1　对象化，可以把错误信息一并处理了。

2　上面可以写测试代码，可以直接运行。

3　文档和类在一起处理了。

后来的他多看了一眼，就导入成功了。到了后面，几位狐友都升级改造了这个类库，比如加上界面处理，比如导出更快。

如果大家的想法都能整合一个超级功能类库，那可牛逼了。

想要VFP技能快速成长，工作升职加薪，泡着咖啡看VFP干活。

请关注加菲猫的VFP，

每篇文章点赞，点在看，多多评论，让更多狐友们成长