陕西小学教师招聘2016:VB中操作EXECL表格（不使用AOD、DAO等）20110819

 VB中操作EXECL表格（不使用AOD、DAO等）介绍如何利用EXCEL对象操作.XLS文件，而不使用DAO等。下面是一个示例代码，昨天写的，是高中学分评定的一个辅助工具，可以把班主任做好的表里面的学号和姓名都弄过来并自动添加对应学分：）以上这些都是固定的啦，用起来省去不少工夫，当然了，这里主要是介绍VB中用EXCEL操作XLS文件，不讨论在EXCEL里直接用VBA实现的问题~~~；还有一个提供“模板”的功能：把学生的分数用一个模拟函数同时输入进去，这个功能大家不要用来作弊哦~~~自己学生的成绩还是要自己一个一个填的才对的起学生麻！而且那个模拟函数，说实在的，就是简单写了几句，模拟的情况并不是很好啦~~~下面看代码：(工程中除必须引用对象外没有对任何对象进行引用,在FORM1里面名字为XlsOpenCD的是一个commandDialog控件,如果测试时提示找不到,请将其删除并填加commandDialog控件,将其命名为XlsOpenCD)注意：代码由一个窗体（FORM1）和三个模块及一个资源文件组成；你复制下来后直接测试会提示错误的，把FORM_LOAD事件里面对模块3中SetLogo函数的调用注释掉就可以啦。代码写的仓促，没有整理，但是要介绍的EXCEL对象基本介绍清楚了。（简述一下思路：建立一个表格文件并保持打开状态，打开要填加的表格，获取相应数据后加入建立的表格中，关闭打开的表格，关闭建立的表格。）'以下复制后保存为FORM1.FRMVERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.ocx"
Begin VB.Form Form1
   Caption         =   "高中学分评定 任课教师报表辅助工具 V1.1.0"
   ClientHeight    =   5325
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   12240
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5325
   ScaleWidth      =   12240
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame6
      Height          =   855
      Left            =   10080
      TabIndex        =   27
      Top             =   4440
      Width           =   2055
      Begin VB.PictureBox LogoPic
         Appearance      =   0  'Flat
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   710
         Left            =   30
         MouseIcon       =   "Form1.frx":0000
         MousePointer    =   99  'Custom
         ScaleHeight     =   705
         ScaleWidth      =   1980
         TabIndex        =   28
         Top             =   120
         Width           =   1980
      End
   End
   Begin VB.Frame Frame5
      Caption         =   "操作结束："
      Height          =   735
      Left            =   60
      TabIndex        =   19
      Top             =   3600
      Width           =   12135
      Begin VB.CheckBox Check5
         Caption         =   "单击“表格编辑结束”打开生成的表格所在文件夹"
         Height          =   255
         Left            =   4800
         TabIndex        =   22
         Top             =   300
         Value           =   1  'Checked
         Width           =   4455
      End
      Begin VB.CheckBox Check4
         Caption         =   "单击“表格编辑结束”打开生成的表格"
         Height          =   255
         Left            =   480
         TabIndex        =   21
         Top             =   300
         Value           =   1  'Checked
         Width           =   3495
      End
      Begin VB.CommandButton Command3
         Caption         =   "表格编辑结束"
         Height          =   375
         Left            =   10200
         TabIndex        =   20
         Top             =   240
         Width           =   1695
      End
   End
   Begin MSComDlg.CommonDialog XlsOpenCD
      Left            =   8880
      Top             =   3720
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame Frame4
      Caption         =   "操作信息："
      Height          =   855
      Left            =   60
      TabIndex        =   10
      Top             =   4440
      Width           =   9975
      Begin VB.Label Label6
         Caption         =   "准备完毕"
         Height          =   495
         Left            =   480
         TabIndex        =   11
         Top             =   240
         Width           =   9255
      End
   End
   Begin VB.Frame Frame3
      Caption         =   "项目添加操作："
      Height          =   2535
      Left            =   10020
      TabIndex        =   8
      Top             =   960
      Width           =   2175
      Begin VB.CheckBox Check1
         Caption         =   "成绩真实情况模拟"
         Height          =   495
         Left            =   120
         TabIndex        =   26
         Top             =   600
         Value           =   1  'Checked
         Width           =   1815
      End
      Begin VB.CheckBox Check2
         Caption         =   "总分按 150 计"
         Height          =   495
         Left            =   120
         TabIndex        =   25
         Top             =   240
         Width           =   1695
      End
      Begin VB.CheckBox Check3
         Caption         =   "去除该表首行数据"
         Height          =   495
         Left            =   120
         TabIndex        =   24
         Top             =   960
         Value           =   1  'Checked
         Width           =   1815
      End
      Begin VB.TextBox TxtNum
         Height          =   270
         Left            =   1440
         TabIndex        =   17
         Text            =   "2"
         Top             =   1560
         Width           =   495
      End
      Begin VB.CommandButton Command1
         Caption         =   "添加表格"
         Height          =   375
         Left            =   240
         TabIndex        =   9
         Top             =   1980
         Width           =   1695
      End
      Begin VB.Label Label7
         Caption         =   "本班对应学分："
         Height          =   255
         Left            =   240
         TabIndex        =   16
         Top             =   1620
         Width           =   1335
      End
   End
   Begin VB.Frame Frame2
      Caption         =   "程序说明信息："
      Height          =   2535
      Left            =   60
      TabIndex        =   7
      Top             =   960
      Width           =   9915
      Begin VB.PictureBox MsgPic
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         BorderStyle     =   0  'None
         FillColor       =   &H00404040&
         ForeColor       =   &H80000008&
         Height          =   2175
         Left            =   120
         ScaleHeight     =   2175
         ScaleWidth      =   9495
         TabIndex        =   18
         Top             =   240
         Width           =   9495
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "表格基本信息："
      Height          =   735
      Left            =   60
      TabIndex        =   0
      Top             =   120
      Width           =   12135
      Begin VB.CommandButton Command2
         Caption         =   "确定设置"
         Height          =   375
         Left            =   10200
         TabIndex        =   23
         Top             =   240
         Width           =   1695
      End
      Begin VB.TextBox Text1
         Height          =   270
         Index           =   4
         Left            =   8400
         TabIndex        =   15
         Text            =   "2004年12月30日"
         Top             =   320
         Width           =   1455
      End
      Begin VB.TextBox Text1
         Height          =   270
         Index           =   3
         Left            =   6600
         TabIndex        =   14
         Text            =   "48"
         Top             =   320
         Width           =   495
      End
      Begin VB.TextBox Text1
         Height          =   270
         Index           =   2
         Left            =   4680
         TabIndex        =   13
         Text            =   "第一学年"
         Top             =   320
         Width           =   975
      End
      Begin VB.TextBox Text1
         Height          =   270
         Index           =   1
         Left            =   2520
         TabIndex        =   12
         Text            =   "化学1"
         Top             =   320
         Width           =   1335
      End
      Begin VB.TextBox Text1
         Height          =   270
         Index           =   0
         Left            =   840
         TabIndex        =   2
         Text            =   "张聪"
         Top             =   320
         Width           =   855
      End
      Begin VB.Label Label5
         Caption         =   "学分认定时间："
         Height          =   255
         Left            =   7200
         TabIndex        =   6
         Top             =   360
         Width           =   1335
      End
      Begin VB.Label Label4
         Caption         =   "学时数目："
         Height          =   255
         Left            =   5760
         TabIndex        =   5
         Top             =   360
         Width           =   975
      End
      Begin VB.Label Label3
         Caption         =   "学年度："
         Height          =   255
         Left            =   3960
         TabIndex        =   4
         Top             =   360
         Width           =   735
      End
      Begin VB.Label Label2
         Caption         =   "课程名："
         Height          =   255
         Left            =   1800
         TabIndex        =   3
         Top             =   360
         Width           =   735
      End
      Begin VB.Label Label1
         Caption         =   "教师名："
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   735
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************************************************
'作者信息：
'演示如何对EXCEL对象进行操作，往往对XLS文件的操作不需要DAO、ADO等，可以直接利用OFFICE来进行，
'当然这也有局限性：未安装MS EXCEL的计算机可能无法正常运行。代码未整理，一步一步写的，乱点儿。
'E-MAIL：  shaoyan5@163.com
'        作者：张聪（ZCSOR）
'        于2006年9月18日
'*******************************************************************************************Option ExplicitPrivate mDataPath As String
Private mTempPath As String
Private mTempFile As String
Private mTempStr As String
Private mXLS As String
Private Sub Check1_Click()
If Check1.Value Then TxtNum.Enabled = True Else TxtNum.Enabled = False
End SubPrivate Sub Command1_Click()
On Error GoTo mErr'添加并处理数据
'设置打开对话框
XlsOpenCD.CancelError = TrueXlsOpenCD.Flags = cdlOFNHideReadOnly
'将用户选定文件以备份方式打开
XlsOpenCD.ShowOpenmTempFile = mTempPath & XlsOpenCD.FileTitleFor mIndex = LBound(mOpenFile) To UBound(mOpenFile)
    Debug.Print mOpenFile(mIndex)
    If mOpenFile(mIndex) = XlsOpenCD.FileName Then
        If MsgBox(mTempFile & "已经添加，真的要重复添加吗？", vbYesNo, "表格已添加") = vbNo Then GoTo mErr:
    End If
NextCommand1.Enabled = False
Command3.Enabled = False
Form1!Label6.Caption = "正在备份和打开表格……"
FileCopy XlsOpenCD.FileName, mTempFileDoEvents
'打开用户选定文件,并处理数据后,添加到输出文件
Set aExcel = CreateObject("excel.application") '创建EXCEL应用程序对象，启动EXCEL应用程序
Set aBook = aExcel.Workbooks.Open(mTempFile)  '打开工作薄，并将其赋给xbook
Set aSheet = aBook.Worksheets(1) '将xbook工作薄中的第一个表赋给xsheet
'Debug.Print aSheet.cells(1, 1), aSheet.cells(1, 2)
'寻找导入表终点
Form1!Label6.Caption = "正在查找表格内条目数……"
For mIndex = 1 To 4096
    If aSheet.cells(mIndex, 1) = "" Then
        aEofSheet = mIndex
        Exit For
    End If
Next'将导入表内容输入到最终表
Form1!Label6.Caption = "正在将" & mTempFile & "内容导入到" & mXLS & "……"If Check2.Value Then mNum = 1.5 Else mNum = 1
Dim mJz As Long
If Check3.Value Then mJz = 2 Else mJz = 1
mIndex = 0
If mEofSheet = 0 Then mEofSheet = 2
For mIndex = mJz To aEofSheet - 1
    mSheet.cells(mEofSheet, 1) = aSheet.cells(mIndex, 1)
    mSheet.cells(mEofSheet, 2) = aSheet.cells(mIndex, 2)
    If Check1.Value Then
        mSheet.cells(mEofSheet, 3) = mRnd(mIndex)
        mSheet.cells(mEofSheet, 4) = TxtNum.Text
    End If
    mEofSheet = mEofSheet + 1
NextaBook.Close
DoEventsSet aSheet = Nothing
Set aBook = Nothing
Set aExcel = NothingReDim Preserve mOpenFile(mOpenNum)
mOpenFile(mOpenNum) = XlsOpenCD.FileName
mOpenNum = mOpenNum + 1Form1!Label6.Caption = "成功将" & mTempFile & "内容导入到" & mXLS & "中。"
XlsMsg XlsOpenCD.FileName & "———添加人数为：" & aEofSheet - 1
Command1.Enabled = True
Command3.Enabled = True
mErr:
Form1!Label6.Caption = "执行了取消操作，等待继续操作……"
Exit Sub
End SubPrivate Sub Command2_Click()
mOpenNum = 0mEofSheet  = 0
ReDim mOpenFile(mOpenNum)For mIndex = 0 To 4
    If Text1(mIndex).Text = "" Then
        MsgBox "信息不完全"
        Exit Sub
    End If
Next
Command2.Enabled = False'建立输出文件
mXLS = mDataPath
For mIndex = 0 To 4
    mXLS = mXLS & Text1(mIndex).Text & "_"
    mTempStr = mTempStr & Text1(mIndex).Text & "_"
Next
mXLS = mXLS & "xfxx.xls"'建立一个新工作薄,用以存储合成后的数据.工作薄处于打开状态等待数据写入
If Not ConstructXls(mXLS) Then Exit Sub'清除消息显示
MsgPic.Cls
XlsMsg "已填加的表格有，请自行观察是否重复："
Frame2.Caption = " 添加表格信息："
Label6.Caption = "生成表格操作完成"
Command1.Enabled = True
End SubPrivate Sub Command3_Click()
Frame2.Caption = " 程序说明信息："
mMsg
'关闭工作薄
Form1!Label6.Caption = "正在关闭工作薄……"
mBook.save
mBook.Close
DoEventsSet mSheet = Nothing
Set mBook = Nothing
Set mExcel = Nothing
Form1!Label6.Caption = "已经关闭工作薄。可以继续制定表格"
Command2.Enabled = True
Command1.Enabled = False
Command3.Enabled = False
If Check4.Value Then Shell "Rundll32.exe url.dll, FileProtocolHandler " & mXLS
If Check5.Value Then Shell "explorer.exe " & mDataPath
End SubPrivate Sub Form_Load()
'显示窗体消息
mMsg
'查询并建立相应目录mDataPath = App.Path & "\示例数据库\"
mMDir mDataPathmTempPath = App.Path & "\TEMP\"
mMDir mTempPath'设置打开对话框过滤器
XlsOpenCD.Filter = "*.xls | *.xls"Command1.Enabled = False
Command3.Enabled = False
SetLogo 101
End SubPublic Sub mMDir(ByVal mPath As String)
'路径查询,如果不存在则建立目录
If Dir(mPath, vbDirectory) <> "." Then MkDir (mPath)
End SubPrivate Sub Form_Unload(Cancel As Integer)
On Error Resume Next
MsgBox "使用中发现问题请联系作者:" & vbCrLf & _
       "E-MAIL: shaoyan5@163.com" & vbCrLf & _
       "            开发者：张聪", vbOKOnly, "感谢使用"
Command3_Click
End Sub
Private Sub LogoPic_Click()
If Check4.Value Then Shell "Rundll32.exe url.dll, FileProtocolHandler http://blog.csdn.net/zcsor"
End SubPrivate Sub Text1_Click(Index As Integer)
Text1(Index).Text = ""
End Sub
'以下在模块1'表格操作相关，这些其实应该写在窗体里，变量有很多是局部的。
Option Explicit
Public mExcel As Object, mBook As Object, mSheet As Object  '成品表对象
Public aExcel As Object, aBook As Object, aSheet As Object  '添加表对象
Public mEofSheet As Long '标志成品表最后一个单元格,已经有的单元格个数
Public aEofSheet As Long '标志添加表最后一个单元格,即本表所有的学生个数
Public mIndex As Long '用于循环
Public mNum As Single  '代表分制
Public mOpenFile() As String '保存已经导入过的文件
Public mOpenNum As Long '保存已经导入的表的个数
'建立一个空的数据表格
Public Function ConstructXls(ByVal xlsPathName As String) As Boolean
On Error GoTo mErr
If Dir(xlsPathName) <> "" Then
    If MsgBox("表格 " & xlsPathName & " 已存在,要删除它吗?" & vbCrLf & "注意:如果不删除将无法继续!", vbYesNo) = vbYes Then Kill xlsPathName Else Exit Function
End If
Form1!Label6.Caption = "正在建立工作薄和表格……"
Set mExcel = CreateObject("excel.application") '创建EXCEL应用程序对象，启动EXCEL应用程序
Set mBook = mExcel.Workbooks.Add '新建一个工作簿，并将其赋给mbook
Set mSheet = mBook.Worksheets(1) '将mbook工作薄中的第一个表赋给msheetmBook.SaveAs (xlsPathName)
'x.Visible = True '让EXCEL可视
mSheet.Columns("A:A").ColumnWidth = 14  '调节第一列的宽度
mSheet.cells(1, 1) = "注册学号" '输入第一行的内容
mSheet.cells(1, 2) = "学生姓名"
mSheet.cells(1, 3) = "成绩"
mSheet.cells(1, 4) = "学分"
DoEvents
Form1!Label6.Caption = "正在向工作薄写入数据……"
ConstructXls = TruemErr:
If Err.Number = 70 Then
    If MsgBox("表格 " & xlsPathName & "正在被使用,无法正确删除,要结束调用它的程序后继续吗?" & vbCrLf & "注意:如果选择“是”，将关闭全部的EXCEL程序", vbYesNo) = vbYes Then killEx xlsPathName Else Exit Function
End If
    Resume NextEnd Function'随机分数函数,基本模拟了实际分数分布
Public Function mRnd(ByVal Index As Long) As Single
Dim upperbound As Long, lowerbound As Long
Dim tmp As SingleRandomizeupperbound = 100 - Index / (aEofSheet - Index) + (aEofSheet - Index)
lowerbound = 60 - Index / (aEofSheet - Index) + (aEofSheet - Index)tmp = (upperbound - lowerbound + 1) * Rnd + lowerboundDo While tmp < 60
    tmp = tmp + (10 - 5 + 1) * Rnd + 5
Loop
Do While tmp > 99
    tmp = tmp - (20 - 1 + 1) * Rnd - 1
Loop
Dim m5 As Single
If CInt(Mid(CStr(tmp), 5, 1)) > 8 Then m5 = 0.5
mRnd = (Int(tmp) + m5) * mNumEnd Function'窗体信息
Public Sub mMsg()
Form1!MsgPic.AutoRedraw = True
Form1!MsgPic.Cls
Form1!MsgPic.Print "说明〖单击“确定设置”后，该信息将消失；导入表为班主任填写完整学生信息后的表格，如：cxfb.xls〗"
Form1!MsgPic.Print "一、程序界面："
Form1!MsgPic.Print "        1 、表格基本信息栏：其中每项都是必填内容，它们组成成品表表的名字（按提示设置即与要求相同）。"
Form1!MsgPic.Print "        2 、项目添加操作栏：这一栏的信息，对应你将打开的数据库在成品表中的设置，详细见以下说明："
Form1!MsgPic.Print "            ①成绩真实情况模拟：勾选后，生成的表中，将带有所有学生的成绩和学分"
Form1!MsgPic.Print "            ②去除该表首行数据：勾选后，会将导入里第一行数据删除后导入最终表格（这不影响打开的原始表）"
Form1!MsgPic.Print "            ③本班对应学分文本：选择“成绩真实情况”后可用，表示成品表中“学分”的数据（适应文理不同）"
Form1!MsgPic.Print "二、使用方法："
Form1!MsgPic.Print "        1 、填写“表格基本信息”栏内容，确信无误后按下“确定设置”按钮。"
Form1!MsgPic.Print "        2 、在“项目添加操作”栏内填写相应内容，该栏内的设置，只对本次将要填加的表有效。确信无误后按下“" & vbCrLf & "            填加表格”按钮。"
Form1!MsgPic.Print "        3 、重复第 2步的操作，直到把所有要填加的表格填加完全，单击“编辑结束”按钮或“退出程序”按钮。"
End Sub
'表格操作信息
Public Sub XlsMsg(ByVal xlsPathName As String)
Form1!MsgPic.Print xlsPathName
End Sub'结束所有EXCEL并删除文件
Public Sub killEx(ByVal xlsPathName As String)
TerminateExcel
Kill xlsPathName
End Sub
'以下在模块2'程序非法结束时,EXCEL将继续运行并锁定文件,导致文件无法打开,查找进程表并结束EXCEL
Option Explicit'======================用于查找进程和终止进程的API函数常数定义=====================
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Const TH32CS_SNAPheaplist = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPthread = &H4
Const TH32CS_SNAPmodule = &H8
Const TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule'查找全部进程，并结束所有EXCEL.EXE
Public Sub TerminateExcel()
Dim i As Long, lPid As Long
Dim Proc As PROCESSENTRY32
Dim hSnapShot As Long
Dim lPHand As Long, TMBack As LonghSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPall, 0) '获得进程“快照”的句柄
Proc.dwSize = Len(Proc)
lPid = ProcessFirst(hSnapShot, Proc) '获取第一个进程的PROCESSENTRY32结构信息数据
i = 0
Do While lPid <> 0 '当返回值非零时继续获取下一个进程
If InStr(1, UCase(Proc.szExeFile), "EXCEL.EXE") Then
    lPHand = Proc.th32ProcessID
    lPHand = OpenProcess(1&, True, lPHand) '获取进程句柄
    TMBack = TerminateProcess(lPHand, 0&) '关闭进程
    CloseHandle lPHand
End If
i = i + 1
lPid = ProcessNext(hSnapShot, Proc) '循环获取下一个进程的PROCESSENTRY32结构信息数据
Loop
CloseHandle hSnapShot '关闭进程“快照”句柄
End Sub
'以下在模块3'资源文件操作模块
Option ExplicitPublic Sub SetLogo(ByVal ResID As Long)
  Form1!LogoPic.Picture = LoadResPicture(ResID, 0)
End Sub
资源文件就不提供了,下载完整版本可以去下载区里面:常用软件---数据库类具体地址：(尚未审核，发布后地指会贴在这里，或去http://download.csdn.net/app/morefile.php?user=zcsor进行下载) 下载地址：http://down.csdn.net/html/2006-09/18/159306.html以上代码中存在一些问题，下载后请在COMMAND3的CLICK事件中添加mEofSheet  = 0 一句，具体见上面。该句修复了第2次建立表格时表格位置的问题，另外，代码中随即成绩除存在严重BUG，导致运行失败；代码中弹出对话框（特别是添加表对话框）后，若点取消，将导致程序无法继续使用的严重BUG。以上3个问题已经修复，进行较全面测试后，将把更新帮本发到下载区，感谢大家的关注。希望大家能把发现的问题通过E-MAIL发给我，因为是我自己开发，没有很多测试机会，需要大家共同完善，当然，完善后的代码会随软件一同发布。感谢大家的支持，我的MAIL：shaoyan5@163.com该代码还存在其他BUG，以及使用时不是很顺手的问题，在下一版本会修正。 本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/zcsor/archive/2006/09/18/1236804.aspx