学生充值记录查询用到了导出EXcel,我一开始看到的时候是懵的,怎样才能导出excel呢?因为直接没有接触过。
逻辑并不是很难。输入卡号,查询导出excel即可。但是本窗体用到了recharge_info表和student_info表
看一下流程图吧!
窗体很简单,就不展示了。看一下重要代码
'判断是否输入卡号
If Trim(txtcardno.Text = "") Then
MsgBox "请输入卡号!", vbOKOnly + vbExclamation, "警告"
txtcardno.Text = ""
txtcardno.SetFocus
Exit Sub
Else
'判断卡号输入是否为数字
If Not IsNumeric(txtcardno.Text) Then
MsgBox "卡号请输入数字!", vbOKOnly + vbExclamation, "警告"
txtcardno.Text = ""
txtcardno.SetFocus
Exit Sub
Else
'判断卡号是否注册
txtsql = "select * from student_info where cardno='" & txtcardno.Text & "'"
Set mrc = executeSQL(txtsql, msgtext)
If mrc.EOF = True Then
MsgBox "卡号没有注册,不存在,请重新输入卡号!", vbOKOnly + vbExclamation, "警告"
txtcardno.Text = ""
txtcardno.SetFocus
Exit Sub
End If
End If
End If
txtsql = "select * from recharge_info"
Set mrc1 = executeSQL(txtsql, msgtext)
With MSHFlexGrid1
.rows = 1
.CellAlignment = 4
.TextMatrix(0, 0) = "学号"
.TextMatrix(0, 1) = "卡号"
.TextMatrix(0, 2) = "充值金额"
.TextMatrix(0, 3) = "充值日期"
.TextMatrix(0, 4) = "充值时间"
.TextMatrix(0, 5) = "充值教师"
Do While mrc1.EOF = False
.rows = .rows + 1
.CellAlignment = 4
.TextMatrix(.rows - 1, 0) = Trim(mrc1.Fields(1))
.TextMatrix(.rows - 1, 1) = Trim(mrc1.Fields(2))
.TextMatrix(.rows - 1, 2) = Trim(mrc1.Fields(3))
.TextMatrix(.rows - 1, 3) = Trim(mrc1.Fields(4))
.TextMatrix(.rows - 1, 4) = Trim(mrc1.Fields(5))
.TextMatrix(.rows - 1, 5) = Trim(mrc1.Fields(6))
mrc1.MoveNext
Loop
End With
一个小知识点,会减少代码量点的呦!
就是把导出excel的代码写进模块中,在窗体中直接调用
On eror GoTo ErrorMsg
Dim xlApp As Object '申明Object类对象 后期绑定
Dim xlBook As Object '
Dim rows As Integer '总行数
Dim cols As Integer '总列数
Dim irow As Integer '
Dim hcol As Integer '
Dim icol As Integer '
If MSFlexGrid1.rows <= 1 Then '判断有无数据
MsgBox "没有数据!", vbInformation, "提示"
Exit Function
Else
Set xlApp = CreateObject("Excel.Application") '生成新的对象引用,引用Excel
Set xlBook = xlApp.Workbooks.Add '创建空白的工作簿
xlApp.Visible = True 'Excel可见
With MSFlexGrid1
rows = .rows
cols = .cols
irow = 0
icol = 1
For hcol = 0 To cols - 1 '列循环
For irow = 1 To rows '行循环
xlApp.Cells(irow, icol).Value = .TextMatrix(irow - 1, hcol) '将表中数据送到Excel
Next irow
icol = icol + 1
Next hcol
End With
With xlApp
.rows(1).Font.Bold = True '第一行为粗体
.Cells.Select '选择整个工作表
'.Columns.AutoFit '自动调整列宽以适应文字
' .Cells(1, 1).Select '
End With
xlApp.DisplayAlerts = False '关闭工作表,不提示用户保存
Set xlApp = Nothing '释放xlApp对象
Set xlBook = Nothing '释放xlBook对象
Exit Function
End If
ErrorMsg:
MsgBox "当前无法导出为Excel!", vbOKOnly + vbExclamation, "提示"
End Function
窗体中:
Rem:导出为EXCEL
Private Sub cmdexcel_Click()
Call ExportToExcel(MSHFlexGrid1)
End Sub