机房收费系统中,不少窗体都要用到MSHFLexgrid控件来显示数据,并要求导入到Excel中,进而方便用户查询和操作数据。
原来在作品展中我们小组设计了一款小软件,是一款关于计票的软件,也用到了导入到Excel这一功能。所以说来也并不陌生了。
下面就为大家介绍三种将VB中数据导入到Excel 的方法。
首先是直接从Text或Label中导入。下面这种方法要自己事先建立一个Excel,优点是可以在指定的不同的磁盘里建立;不足之处是每次都要自己指定,比较麻烦,而且一旦程序完成,用户将无法建立其他新的工作表,也不得将规定建立的工作表改名。适用于开发者自己使用。
Private Sub LinkExcel_Click() Dim xlApp As Excel.Application '定义一个新的Excel应用程序 Dim xlBook As Excel.Workbook '定义新的工作表 Dim xlSheet As Excel.Worksheet '定义新的工作簿 Set xlApp = CreateObject("Excel.Application") '实例化应用程序 xlApp.Visible = True '设置为可见 Set xlBook = xlApp.Workbooks.Open(App.Path & "\选举结果1.xls") '打开所建立的"\选举结果1.xls"工作表,这是自己手动建立的工作表 Set xlSheet = xlBook.Worksheets(1) '设置当前活动工作簿sheet1 For i = 1 To n On Error Resume Next x = LblRank(i).Caption '要显示的Lblrank中的数据 y = TxtName(i).Text '要显示的TxtName中的数据 z = LblTickets(i).Caption '要显示的LblTickets中的数据 xlSheet.Cells(i,1).Value = x '将要显示的数据定位到Excel单元格 xlSheet.Cells(i,2).Value = y xlSheet.Cells(i,3).Value = z Next i xlApp.Application.Quit '释放内存,将控制权交还给Excel Set xlApp = Nothing End Sub
下面这一种就比较方便了,既可以自动建立Excel 工作表,也可以自动存储,存储位置可任意选择,限制很少;不足就是开发代码比较长。这种方法适用范围广,比较方便用户。
Private Sub txtOutPut_Click() Dim objExlApp As New Excel.Application '声明一个EXCEL应用程序 Dim objExlBook As New Excel.Workbook '声明一个EXCEL工作表 Dim objExlSheet As New Excel.Worksheet '声明一个EXCEL工作簿 Dim sFileName As String '定义存储的文件名变量 Dim lngRowsCount As Long '声明行数变量 Dim lngColumnsCount As Long '声明列数变量 Dim lngRow As Long '声明单行 Dim lngColumn As Long '声明单列 Dim strText As String '声明保存的文件名变量 '先判断MSFG1中有没有数据 If MSFG1.Rows > 1 Then '另存到XLS文件 ' 设置“取消”为 True dlgSave.CancelError = False On Error Resume Next Set objExlApp = GetObject(,"Excel.Application") If Err.Number <> 0 Then Set objExlApp = CreateObject("Excel.Application") End If '错误处理 On Error GoTo ErrHandler '保存对话框处理 dlgSave.Filter = "Excel文件(*.xls)|*.xls|所有文件|*.*" '文件类型 dlgSave.FileName = "杨建" & Format(Now,"yyyy-mm-dd") & ".XLS" '文件名 dlgSave.ShowSave '在Excel中增加一个工作簿 Set objExlBook = objExlApp.Workbooks.Add '实例化一个表单,并使其成为Excel的活动工作表单 Set objExlSheet = objExlBook.Worksheets(1) '设置要使用的工作表,使其可见,并实例化EXCEL工作表单 objExlApp.Visible = True objExlApp.ScreenUpdating = True objExlApp.DisplayAlerts = True Set objExlSheet = objExlBook.Sheets(1) lngRowsCount = MSFG1.Rows lngColumnsCount = MSFG1.Cols '导入数据 For lngRow = 1 To lngRowsCount For lngColumn = 1 To lngColumnsCount strText = MSFG1.TextMatrix(lngRow - 1,lngColumn - 1) If IsNull(strText) = False And strText <> "" Then objExlSheet.Cells(lngRow,lngColumn) = strText End If Next lngColumn Next lngRow objExlApp.Visible = True sFileName = dlgSave.FileName '导出文件的文件名与保存时的文件名相同 objExlSheet.SaveAs sFileName '设置保存时的文件名 objExlApp.Application.Quit '终止Excel程序运行 Set objExlSheet = Nothing '释放内存里的变量,交还控制给Excel
Set objExlBook = Nothing Set objExlApp = Nothing 'objExlBook.Close MsgBox "文件已生成,在:" & sFileName '提示文件生成及保存的路径 Else MsgBox "没有可导出的数据,请先进行查询!" End If ErrHandler: Exit Sub End Sub
第三种方法就是自己定义一个导入到Excel的函数,到时候直接调用就可以了。函数的定义方法用很多种,就不在此为大家过多叙述了,举一个例子即可。
Public Sub ExportToExcel() '导出数据到excel On Error Resume Next Dim oExcel As Excel.Application Dim obook As Excel.Workbook Dim objExlSht As Excel.Worksheet Dim listrst() As Variant Dim X,Y As Long Dim i,n As Integer Set oExcel = New Excel.Application Set obook = oExcel.Workbooks.Add Set objExlSht = obook.ActiveSheet X = myflexgrid.Rows Y = myflexgrid.Cols ReDim listrst(X,Y) For i = 0 To myflexgrid.Rows - 1 For n = 0 To myflexgrid.Cols - 1 listrst(i,n) = Trim(myflexgrid.TextMatrix(i,n)) Next Next DoEvents With objExlSht oExcel.Intersect(.Range(.Rows(1),.Rows(X)),.Range(.Columns(1),.Columns(Y))).Value = listrst End With oExcel.Visible = True oExcel.Interactive = True End Sub