实际生活中常常要将 一些数据导入到Excel表格中,方便操作如打印等.机房收费
系统中关于充值记录的N多查询结果均是如此.我把两个窗体的结果分别从两个方面实现了这个功能,总结在下面和大家分享.
第一种,将已经查询到的结果用MSFlexGrid控件显示出来,然后从该控件导出. www.2cto.com
[vb]
Option Explicit
Private Sub cmdExport_Click()
Dim i As Long
Dim j As Long
On Error Resume Next
If myMSFlexGrid.TextMatrix(1, 0) = "" Then
MsgBox "没有数据导出", vbInformation, "提示"
Exit Sub
End If
Dim excelApp As Excel.Application
Set excelApp = New Excel.Application
Set excelApp = CreateObject("Excel.Application")
Dim exbook As Excel.Workbook
Dim exsheet As Excel.Worksheet
Set exbook = excelApp.Workbooks.Add
excelApp.SheetsInNewWorkbook = 1
excelApp.Visible = True
' Me.MousePointer = vbHourglass '控制鼠标为读取数据 www.2cto.com
With excelApp.ActiveSheet
For i = 1 To myMSFlexGrid.Rows
For j = 1 To myMSFlexGrid.Cols
.Cells(i, j).Value = "" & Format$(myMSFlexGrid.TextMatrix(i - 1, j - 1))
Next j
Next i
End With
' Me.MousePointer = 0 '释放鼠标为读取数据
Set exsheet = Nothing
Set exbook = Nothing
Set excelApp = Nothing
End Sub
Private Sub cmdQuery_Click()
Dim strSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
If Testtxt(txtCardNo.Text) Then
MsgBox "请输入卡号!", vbOKOnly + vbExclamation, "提示"
txtCardNo.SetFocus
Exit Sub
End If
If Not IsNumeric(txtCardNo.Text) Then
MsgBox "请输入数字!", vbOKOnly + vbExclamation, "提示"
txtCardNo.SetFocus
Exit Sub
End If
www.2cto.com
strSQL = "select cardno 卡号,addcash 充值金额,date 充值日期,time 充值时间,userid 充值教师 from recharge_info where cardno='" & txtCardNo.Text & "'"
Set mrc = ExecuteSQL(strSQL, MsgText)
If mrc.EOF = True Then
MsgBox "此卡不存在!", vbOKOnly + vbExclamation, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
With myMSFlexGrid
.Rows = 1
.CellAlignment = 4
Dim k As Integer
For k = 0 To mrc.Fields.Count - 1
.TextMatrix(0, k) = mrc.Fields(k).Name
.ColWidth(k) = 1300
Next k
Do While mrc.EOF = False
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 0) = mrc.Fields("卡号").Value
.TextMatrix(.Rows - 1, 1) = mrc.Fields("充值金额").Value
.TextMatrix(.Rows - 1, 2) = mrc.Fields("充值日期").Value
.TextMatrix(.Rows - 1, 3) = mrc.Fields("充值时间").Value
.TextMatrix(.Rows - 1, 4) = mrc.Fields("充值教师").Value
mrc.MoveNext
Loop
End With
End Sub
www.2cto.com
第二种,也是将查询到的结果用MSFlexGrid控件显示出来,但是从记录集直接导出.
[vb]
Option Explicit
Dim strSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
'导出为Excel
Private Sub cmdExport_Click()
Dim xlapp1 As Excel.Application
Dim xlbook1 As Excel.Workbook
Dim xlsheet1 As Excel.Worksheet
Set xlapp1 = CreateObject("Excel.Application")
Set xlbook1 = xlapp1.Workbooks.Add
Set xlsheet1 = xlbook1.Worksheets(1)
'添加字段名
Dim i As Integer
For i = 0 To mrc.Fields.Count - 1
xlsheet1.Cells(1, i + 1) = mrc.Fields(i).Name