使用VB实现Excel自动获取外部数据
2006-02-27 11:54:50 来源:WEB开发网 闂傚倸鍊搁崐鎼佸磹閹间礁纾归柟闂寸绾惧綊鏌熼梻瀵割槮缁炬儳缍婇弻鐔兼⒒鐎靛壊妲紒鐐劤缂嶅﹪寮婚悢鍏尖拻閻庨潧澹婂Σ顔剧磼閻愵剙鍔ょ紓宥咃躬瀵鎮㈤崗灏栨嫽闁诲酣娼ф竟濠偽i鍓х<闁绘劦鍓欓崝銈囩磽瀹ュ拑韬€殿喖顭烽幃銏ゅ礂鐏忔牗瀚介梺璇查叄濞佳勭珶婵犲伣锝夘敊閸撗咃紲闂佺粯鍔﹂崜娆撳礉閵堝洨纾界€广儱鎷戦煬顒傗偓娈垮枛椤兘骞冮姀銈呯閻忓繑鐗楃€氫粙姊虹拠鏌ュ弰婵炰匠鍕彾濠电姴浼i敐澶樻晩闁告挆鍜冪床闂備浇顕栭崹搴ㄥ礃閿濆棗鐦遍梻鍌欒兌椤㈠﹤鈻嶉弴銏犵闁搞儺鍓欓悘鎶芥煛閸愩劎澧曠紒鈧崘鈹夸簻闊洤娴烽ˇ锕€霉濠婂牏鐣洪柡灞诲妼閳规垿宕卞▎蹇撴瘓缂傚倷闄嶉崝搴e垝椤栫偛桅闁告洦鍨扮粻鎶芥倵閿濆簼绨藉ù鐘荤畺濮婃椽妫冨☉娆愭倷闁诲孩鐭崡鎶芥偘椤曗偓瀹曞爼顢楁径瀣珫婵犳鍣徊鍓р偓绗涘洤绠查柛銉墮閽冪喖鏌i弬鎸庢喐闁荤喎缍婇弻娑⑩€﹂幋婵囩亪濡炪値鍓欓悧鍡涒€旈崘顔嘉ч幖绮光偓鑼嚬缂傚倷绶¢崰妤呭箰閹间焦鍋╅柣鎴f绾偓闂佺粯鍔曠粔闈浳涢崘顔兼槬闁逞屽墯閵囧嫰骞掗幋婵愪紑閻庤鎸风粈渚€鍩為幋锔藉亹闁圭粯甯╂导鈧紓浣瑰劤瑜扮偟鍒掑▎鎾宠摕婵炴垶鐭▽顏堟煙鐟欏嫬濮囨い銉︾箞濮婃椽鏌呴悙鑼跺濠⒀傚嵆閺岀喖鎼归锝呯3闂佹寧绻勯崑娑㈠煘閹寸姭鍋撻敐搴樺亾椤撴稒娅婇柡灞界У濞碱亪骞忕仦钘夊腐闂備焦鐪归崐鏇㈠箠閹邦喗顫曢柟鎯х摠婵挳鏌涢幘鏉戠祷闁告挸宕—鍐Χ閸℃浠搁梺鑽ゅ暱閺呮盯鎮鹃悜钘壩ㄧ憸澶愬磻閹剧粯鏅查幖绮瑰墲閻忓秹姊虹紒妯诲鞍婵炲弶锕㈡俊鐢稿礋椤栨氨鐤€闂傚倸鐗婄粙鎰姳閼测晝纾藉ù锝堟閻撴劖鎱ㄥΟ绋垮婵″弶鍔欓獮妯兼嫚閼碱剦妲伴梻浣稿暱閹碱偊宕愭繝姣稿洭寮舵惔鎾存杸濡炪倖姊婚妴瀣啅閵夛负浜滄い鎾跺仜濡插鏌i敐鍥у幋妤犵偞甯¢獮瀣籍閳ь剟鎮楁繝姘拺閻熸瑥瀚崕妤呮煕濡 鍋撻悢鎻掑緧婵犵數濮烽弫鍛婃叏閻戣棄鏋侀柛娑橈攻閸欏繑銇勯幘鍗炵仼缁炬儳顭烽弻鐔煎礈瑜忕敮娑㈡煃闁垮鐏﹂柕鍥у楠炴帡宕卞鎯ь棜缂傚倸鍊风粈渚€藝闁秴鏋佸┑鐘虫皑瀹撲線鏌涢埄鍐姇闁稿﹦鍏橀弻娑樷攽閸℃浼€濡炪倖姊归崝鏇㈠煘閹达附鍊婚柛銉㈡櫇鏍¢梻浣告啞閹稿鎮烽敂鐣屸攳濠电姴娲﹂崵鍐煃閸濆嫬鏆熼柨娑欑矒濮婇缚銇愰幒鎴滃枈闂佸憡鐟ユ鎼佸煝閹炬枼鍫柛顐ゅ枔閸樻悂鏌h箛鏇炰户缁绢厼鐖煎畷鎴﹀箻鐠囪尙鐤€婵炶揪绲介幉锟犲磹椤栫偞鈷戠痪顓炴噹娴滃綊鎮跺☉鏍у姦闁糕斁鍋撳銈嗗笒閸燁偊鎯冨ú顏呯厸濞达絽婀辨晶顏堟煃鐟欏嫬鐏撮柟顔界懇瀵爼骞嬮悩杈敇闂傚倷绀佸﹢杈ㄧ仚闂佺濮ょ划搴ㄥ礆閹烘绫嶉柛顐ゅ枎娴犺櫣绱撴担鍓插創妞ゆ洘濞婇弫鍐磼濞戞艾骞堥梻浣告惈濞层垽宕濆畝鍕€堕柣妯肩帛閻撴洟鏌熼懜顒€濡煎ù婊勫劤閳规垿鏁嶉崟顐℃澀闂佺ǹ锕ラ悧鐘茬暦濠靛鏅濋柍褜鍓熼垾锕傚锤濡も偓閻掑灚銇勯幒宥堝厡缂佺姴澧介埀顒€鍘滈崑鎾斥攽閻樿京绐旈柛瀣殔閳规垿顢欑涵鐑界反濠电偛鎷戠徊鍨i幇鏉跨闁瑰啿纾崰鎾诲箯閻樼粯鍤戦柤绋跨仛濮f劙姊婚崒姘偓鐑芥嚄閼哥數浠氭繝鐢靛仜椤曨參宕楀Ο渚殨妞ゆ劑鍊栫€氭氨鈧懓澹婇崰鏍р枔閵婏妇绡€闁汇垽娼ф牎缂佺偓婢樼粔鐟邦嚕閺屻儱绠甸柟鐑樼箘閸炵敻鏌i悩鐑橆仩閻忓繈鍔岄蹇涘Ψ瑜夐崑鎾舵喆閸曨剙纰嶅┑鈽嗗亝缁诲倿锝炶箛娑欐優闁革富鍘鹃敍婊冣攽閳藉棗鐏犻柟纰卞亰閿濈偛顓奸崶鈺冿紳婵炶揪缍侀ˉ鎾诲礉瀹ュ鐓欑紒瀣仢閺嗛亶鏌i敐鍥у幋妤犵偛顑夐弫鍐焵椤掑倻涓嶅┑鐘崇閸嬶綁鏌涢妷鎴濆暟妤犲洭鎮楃憴鍕碍缂佸鎸抽垾鏃堝礃椤斿槈褔鏌涢埄鍏狀亪妫勫鍥╃=濞达絽澹婇崕鎰版煕閵娿儱顣崇紒顔碱儏椤撳吋寰勭€n亖鍋撻柨瀣ㄤ簻闁瑰搫绉堕ˇ锔锯偓娈垮枛閻忔繈鍩為幋锕€鐓¢柛鈩冾殘娴狀垶姊洪崨濠庣劶闁告洦鍙庡ú鍛婁繆閵堝繒鍒伴柛鐕佸灦瀹曟劙宕归锝呭伎濠碘槅鍨抽崢褎绂嶆ィ鍐╁€垫慨妯煎亾鐎氾拷

核心提示:Excel表格生成和公式设置十分强大便利,是一个强有力的信息分析与处理工具,使用VB实现Excel自动获取外部数据,VisualBasic是一套可视化、面向对象、事件驱动方式的结构化高级程序设计语言,正成为高效率的Windows应用程序开发工具,使它作为VisualBasic模块表中的一个子程序,并设置调用参数,由于微
Excel表格生成和公式设置十分强大便利,是一个强有力的信息分析与处理工具。VisualBasic是一套可视化、面向对象、事件驱动方式的结构化高级程序设计语言,正成为高效率的Windows应用程序开发工具。由于微软的努力,VisualBasic应用程序版可作为一种通用宏语言被所有微软可编程应用软件共享。
Excel面始之初带有表格处理类软件中功能最强的宏语言,通过单击“工具”菜单中的“宏”,选择宏名来调用宏过程。随后发展至VisualBasicforapplication专用版,可制作按钮、复选框、单选钮等控件,赋控件以宏名,单击控件运行宏,事件驱动方式就Click(单击)一种。新近推出的Office97套件中的Excel97,在“工具”菜单中选择“宏”后,就会发现增加了“VisualBasic编辑器”功能。运用这个新增功能,就完全与VisualBasic编程无异了。在菜单栏上单击鼠标右键,选择弹出式菜单中的“控件工具箱”,在“控件工具箱”工具条上,单击待添加的控件按钮,在工作表中将控件拖曳到所需位置和大小,单击鼠标右键选中“属性”设置控件属性后,双击控件就会出现VisualBasic编辑器。选择该控件的一个事件如Click或Change,编写程序。在工作表中操作该控件,如鼠标单击、键入字符等,则触发相应事件,执行相应程序。
笔者在Excel97平台,采用VisualBasic应用程序版开发了一套“通用报表分析系统”。该系统用于拥有众多子公司的母公司的每月财务报表合并汇总。所有子公司的统计报表如资产负债表、损益表是由FoxBase编制的财务软件生成的dbf文件,取名为ATV001xx.dbf----xx月份资产负债表,ATV002xx.dbf----xx月份损益表等。一个子公司的所有dbf文件放在一个单独的目录中,如C:\T\palm1,C:\T\palm2等。母公司每月份生成的汇总报表为TTTyymm.xls(yy----年份,mm----月份),它有“资产负债表”、“损益表”等若干工作表组成。每张工作表是由所有子公司相应的dbf文件的相应项目的数据相加而成。只要将dbf文件逐一转化到TTTyymm.xls中去,很容易利用Excel的公式设置功能生成母公司的每张汇总报表。
这套系统的关键在于如何将所有dbf文件转换到同一个Excel工作簿中。直接通过“文件”菜单中的“打开”项,选择文件类型为dBase文件(*.dbf),可将dbf文件转换到Excel工作簿中,但这工作簿只存转换而来的一张工作表,其他表都自动关闭了。另外,通过“工具”菜单中的“向导”,选择“文件转换”后,只是将一系列dbf文件转换为一系列xls文件而已。于是采用建立ODBC数据源获取外部数据的办法,将dbf文件逐一转换到一个Excel工作簿内,且用VisualBasicforApplication将转换过程自动化。只要按一下图1中的“生成报表”按钮,就能完成所有dbf文件的转换,且利用Excel公式自动计算功能完成所有报表的汇总计算。按“显示报表”按钮,选择表名,可以浏览报表数据。
具体的方法是:
一、建立ODBC数据源
(1)打开“数据”菜单,选择“获取外部数据”,然后单击“新建查询”;
(2)在“选择数据源”对话框中,双击“<新数据源>”;
(3)出现“创建新数据源”对话框,输入数据源名称,选择驱动程序如MicrosoftdBaseDriver(*.dbf),单击“连接”;
(4)在“ODBCdBase安装”对话框中,单击“使用当前工作目录”前的复选框,去掉缺省(,单击“选定目录(s)”,选择子公司存放dbf文件的目录如C:\T\palm1,连按“确定”;
(5)当出现MicrosoftQuary对话框时,单击“关闭”,退出。不要理会出现的警示信息,因为此时只需建立数据源,并不需要用MicrosoftQuery查询数据;
(6)重复上述步骤,在(4)中改换另一家子公司的目录,就为另一家子公司建立一个数据源。必须建立所有子公司的数据源。
二、手动获取外部数据
(1)单击“数据”,选取“获取外部数据”,单击“新建查询”;
(2)出现“选取数据源”对话框,点中“使用查询向导创建/编辑查询”前的复选框,然后双击数据源名,如palm1;
(3)在“查询向导——选择列”对话框中选择一个查询表名,单击>键,“查询中用到的列”框内会出现表中所有列名,单击“下一步”;
(4)出现“查询向导——过滤数据”,单击“下一步”;
(5)出现“查询向导——排序顺序”,单击“下一步”;
(6)出现“查询向导——完成”,点中“将数据返回MicrosoftExcel”前的单选钮,单击“完成”;
(7)出现“将外部数据返回到Excel”对话框,选中“新建工作表”,按“确定”;
(8)在建立查询的工作簿内新建工作表,并放入转换好的数据。这样就将一个dbf文件转换好了。
(9)重复上述过程,所有子公司的dbf文件转换到同一个工作簿中。
三、使用VB实现Excel自动获取外部数据
(1)进行手动获取外部数据(1)步骤前,单击“工具”菜单中的“宏”,选择“录制新宏”,在“宏名”的编辑框中键入宏名dbftoxls,按“确定”键;
(2)完成手动获取外部数据(1)-(8)步骤;
(3)单击“工具”菜单中的“宏”,选择“停止录制”。这样就将获取外部数据的过程记录为宏。
(4)编辑dbftoxls宏,加以修改,使它作为VisualBasic模块表中的一个子程序,并设置调用参数。
提供的程序如下:
`设置初值
Constapppath="c:\mydocuments\palmxls\"
Constmodulefile=apppath "module.xls"
ConststaticsPRe="TTT"
Constdbfpre="ATV00"
`调用dbftoxls的模块
PrivateSubCmdgeneratetable_Click()
DimstaticsfileAsString
Dims1AsString
Dims2AsString
Dims3AsString
DimidyesAsInteger
DimdbfstringAsString
OnErrorGoToerrhandler1
idyes=6
s1=txtyear.Text
s1=Mid(s1,3,2)
s2=txtmonth.Text
IfLen(s2)=1Then
s2="0" s2
EndIf
staticsfile=apppath staticspre s1 s2 ".xls"
IfFileLen(staticsfile)>0Then
choice=MsgBox("该年月报表已存在,是否重新生成?",vbYesNo vbExclamation vbDefaultButton1,"")
Ifchoice=idyesThen
Workbooks.OpenFileName:=staticsfile
Fori=0Tocompanynum-1
Forj=0Totablenum-1
dbfstring=dbfpre Trim(Str$(j 1)) s2
sqlstring=sqlstringfunc(dbfstring,fieldlist(),tablefieldnum(j))
Calldbftoxls(s(i,j),sqlstring)
Nextj
Nexti
ActiveWorkbook.Save
ActiveWorkbook.Close
EndIf
EndIf
ExitSub
errhandler1:
SelectCaseErr
Case53
Workbooks.OpenFileName:=modulefile
s3=s1 "年" s2 "月"
Sheets("资产负债表").Range("e4").FormulaR1C1="'" s3
ActiveWorkbook.SaveAsFileName:=staticsfile,FileFormat_
:=xlNormal,PassWord:="",WriteResPassword:="",ReadOnlyRecommended:=_
False,CreateBackup:=False
Fori=0Tocompanynum-1
Forj=0Totablenum-1
dbfstring=dbfpre Trim(Str$(j 1)) s2
sqlstring=sqlstringfunc(dbfstring,fieldlist(),tablefieldnum(j))
Calldbftoxls(s(i,j),sqlstring)
Nextj
Nexti
ActiveWorkbook.Save
ActiveWorkbook.Close
EndSelect
EndSub
`dbftoxls子程序
Subdbftoxls(activesheetname,sqlstring)
Sheets(activesheetname).Activate
Cells.Select
Selection.Clear
Range("a1").Select
WithActiveSheet.QueryTables.Add(Connection:=Array(Array(_
"ODBC;CollatingSequence=ASCII;DBQ=C:\T\palm1;DefaultDir=C:\T
\palm1;Deleted=1;Driver={MicrosoftdBaseDriver(*.dbf)};DriverId=533;FIL"_
),Array(_
"=dBaseIII;ImplicitCommitSync=Yes;MaxBufferSize=512;MaxScanRows=
8;PageTimeout=600;SafeTransactions=0;Statistics=0;Threads=3;Use"_
),Array("rCommitSync=Yes;")),Destination:=Range("A1"))
.Sql=Array(sqlstring)
.FieldNames=True
.RefreshStyle=xlInsertDeleteCells
.RowNumbers=False
.FillAdjacentFormulas=False
.RefreshOnFileOpen=False
.HasAutoFormat=True
.BackgroundQuery=True
.TablesOnlyFromHTML=True
.RefreshBackgroundQuery:=False
.SavePassword=True
.SaveData=True
EndWith
EndSub->
更多精彩
赞助商链接