龙盟编程博客 | 无障碍搜索 | 云盘搜索神器
快速搜索
主页 > 软件开发 > VB开发 >

使用VB实现Excel自动获取外部数据

时间:2009-12-30 15:42来源:未知 作者:admin 点击:
分享到:
Excel表格生成和公式设置十分强大便利,是一个强有力的信息分析与处理工具。VisualBasic是一套可视化、面向对象、事件驱动方式的结构化高级程序设计语言,正成为高效率的Windows应用程
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:Tpalm1,C:Tpalm2等。母公司每月份生成的汇总报表为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:Tpalm1,连按“确定”;
  (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:mydocumentspalmxls"
  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:Tpalm1;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->

精彩图集

赞助商链接