|
机房收费系统中，不少窗体都要用到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
当然，还有其他方法可以实现该功能，大家可以继续去深入探索，找到适合自己的高效快捷方便的方法，本次就先介绍到这里。
（编辑：李大同）
【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
|
