返回首页
当前位置: 主页 > 办公软件 > Powerpoint教程 >

使用数据库做PPT交互式试题基础

时间:2014-09-30 16:15来源:电脑教程学习网 www.etwiki.cn 编辑:admin

第一课:如何调用题库自动生成试题界面,并实现滚动控制

第二课:交互初步,做一个联连(用到了VB的自定义类)。不会VB没有关系,从这里开始学吧,任何一本教材也不会有我罗嗦的了--

第三课:快捷框排序,让学员更方便地知道哪些题尚未做。

环境:PPT2003、ACCESS2000。

'调用ACCESS数据库,设置多选项简单方法:

'第一步:使用ACCESS建立试题库function_chr.mdb,内含表chr内建立rubric字段(试题标题),option1....option4(预设4个选择项字段)。
'提示:使用ACCESS版本必须低于ADO类的版本,即能被ADO识别

'第二步:设置PPT启用宏
'打开ppt,设置工具/宏/安全性为中或低,然后关闭后重新启动PPT。

'第三步:在幻灯片内添加必须控件。
'在当前幻灯片,打开VB工具栏(使用自定义工具栏添加)
'新建一个label或textbox控件,用于放置试题题目;
'新建4个checkbox控件,用于放置试题选项
'新建1个commandbutton控件,用于启动VBA命令,调用ACCESS库

'第四步:导入ADO类
'使用菜单工具/引入命令,引入Microsoft ActiveX Data objects 2.5 library类

'第五步:在声明内声明connection、recordset对象实例,并赋给相应变量
'本例为本地调用,采用早期绑定,仅使用ADO两个最重要的对象connection和Recordset对象
'connection对象,负责从客户端到数据库服务器的连接,即指定要用到的数据库
'recordset对象:表示查询结果集,查询结果返回给该对象。
'注意若要在类模块内声明还得指明APP,这里不讲,读者先自己探索吧
'Public dbconnect As ADODB.Connection
'Public rs As ADODB.Connection
'Set dbconnect = New ADODB.Recordset
'Set rs = New ADODB.Recordset

Public dbconnect As New ADODB.Connection
Public rs As New ADODB.Recordset

Private Sub CommandButton1_Click()

'若连接对象已经建立,关闭它
If dbconnect.State = adStateOpen And Not IsEmpty(adStateOpen) Then dbconnect.Close
'指定用于连接的提供者的名称,我理解为数据源的设备驱动程序
dbconnect.Provider = "microsoft.jet.oledb.4.0" 'access 97 ois 3.51
'通过传递详细的字符串来指定数据源,这里取用了相对路径调用
dbconnect.ConnectionString = "data\function_chr.mdb"
'建立连接
dbconnect.Open

'若记录集已经打开关闭它
If rs.State = adStateOpen And Not IsEmpty(adStateOpen) Then rs.Close
'按用户要求打开记录集,open的具体用法请查阅帮助
rs.Open "chr", dbconnect, adOpenDynamic, adLockOptimistic 'chr是表名,包含中function_chr.mdb里,结果为全部字段的记录集
'rs.Open "select rubric from chr", dbconnect, adOpenDynamic, adLockOptimistic '查询结果为仅含字段Rubric的记录集

'使用当前记录给幻灯片内的控件属性赋值,记录的移动等大家自己研究吧
Me.TextBox1.Text = rs!rubric 'me指的是当前幻灯片,并非VB工程窗口,可以省略
Me.CheckBox1.Caption = rs!option1
Me.CheckBox2.Caption = rs!option2
Me.CheckBox2.Caption = rs!option3
Me.CheckBox2.Caption = rs!option4

'调用完毕后,记得关闭、撤销对象,释放内存资源
rs.Close '该方法仅关闭之,对象并未撤销,可再次调用
Set rs = Nothing '撤销对象
Set dbconnect = Nothing

'至于如何实现另建一个用户窗体修改试题或是在PPT实现试题库修改,以及把结果保存入ACCESS库,大家来续接吧,这里不再多讲的。

End Sub
'原理:后期绑定外部ACCESS数据库;使用两重循环语句(FOR...Next)自动生成试题控件,并利用数据库信息设置控件属性;使用框架的滑块,使试题能滚动,实现单个界面的大题库显现。
'环境:PPT2003,ACCESS库为97库(2002等可转换后使用)。
'使用控件:框架(Frame)、命令按钮(command)
'自动生成控件:标签(Lable),其标题(caption)设为试题的题目;选项按钮(CheckBox)为选择项(预设为4个),
'效果:界面生成时自动在框架内生成试题控件,并可利用框架滑块实现试题的全部显示,点击命令按钮退出界面。

初学者须知:
1、按ALT+F11,进入PPT的VB工程设计界面。
2、控件可以通过工具箱添加(可通过点击菜单“视图”/“工具箱”,显示“工具箱”)。
3、工具箱没有的控件可以通过在工具箱上点鼠标右键,在弹出的快捷菜单内选择“添加部件”查找。
4、“视图”菜单非常重要,要先熟悉一下。“属性窗口”、“工程资源管理器”等都可以通过它显示出来。
5、“插入”菜单也应先熟悉一下,插入类模块、用户窗口等都要用到它。
6、上传所有代码可直接拷贝使用。

前期准备:
建立试题的ACCESS数据库,文件名称为function_chr.mdb,内含表Chr,字段至少有4个,字段名随意取,数值类型设为文本。第一个字段(Field(0))为试题的题目,后三个为选择项,每条记录代表一道试题。


言归正传,我们开始吧。
1、插入一个类模块(是类模块不是一般的模块),插入一个用户窗体(名称改为TestFrm)。点击用户窗体使用“视图”菜单调出“工具箱”、“用户资源管理器”。
2、在类模块的声明里声明连接数据库的两个关键对象变量:
Public conn1 As ADODB.Connection
Public setpxp As ADODB.Recordset
3、在用户窗体内添加一个框架控件和一个命令按钮,调整到合适大小;设置框架属性caption="":ScrollBars=2(即使用垂直滑块);名称在这里都采用缺省值。
4、设置命令按扭的Click方法(直接在它上面双击就出来了):
Unload TestFrm'释放表单
5、双击用户表单(TestFrm),在通用声明区域内添加下列代码:

Option Explicit'变量必须先声明才能使用,避免变量的类型出现不可预测的错误,便于修改程序

'*---------------------------------------------------------------------*
'*在VBA内使用一个Frame控件代替VB内的两个Picture控件实现试题的滚动显现
'*---------------------------------------------------------------------*
'*---------------------------------------------------------------------*
'*生成数据库连接及记录集实例对象
'*---------------------------------------------------------------------*
Private dbconnect As New ADODB.Connection
Private rs As New ADODB.Recordset

'*---------------------------------------------------------------------*
'*定义自动添加的控件变量,以两重循环语句分别设计试题的题目的选项
'*---------------------------------------------------------------------*
'使用 WithEvents 关键字声明对象变量,允许您编程该控件的事件。
'对象变量被设置为由 Add 方法返回的引用。
'Dim WithEvents labObject As Label '这是VB的用法,在VBA里行不通
'Dim WithEvents chkObject As CheckBox
Dim Labobject As Control '设置试题控件为控件对象变量
Dim ChkObject As Control

Private i, j As Integer '内外循环计数器
'*---------------------------------------------------------------------*
'*确定自动添加的控件的相关参数
'*---------------------------------------------------------------------*
Const WidthRubric = 320 '题目长度,即Label控件对象的长度
Const WidthOptn = 310 '放置选项的checkbox控件的最大长度
Const VDistance = 4 '纵向间距
Const HDistance = 5 '横向间距
Const LeftDistance = 5 '左边间距
Const LeftAppend = 20 '左悬挂距离
Const topini = 40 '第一行的顶部位置
Const nOpn = "4" '选项数目

Private WidthOptnExt As Integer '选项显示的实际长度
Private nLstChkTop As Integer '当前Checkbox的Top,计算下一控件的Top

6、在用户表单(TestFrm)的UserForm_Initialize的事件内添加下列代码。添加成功后,我们今天的目的就实现了。表单加载到内在里时先加载Load事件,Initialize事件在其后来初始表单及其上的所有控件。

 

第二课做出来真不易,涉及到自定义类,本人在VB里很少用到所以做的时间长了,计划二周内搞定,谁知又被派出去了几日-----------请大家见谅.

如果你能把这一课搞清楚,并且能够独立地进行一翻整理、优化,后面的课,你就完全可以不看了,举一反三就可以了。

目前,本课内容各大小网站均未见登,连日来跑了北京、西安、郑州几大书城查找这方面的资料,均未果。但终归,功夫不负有心人,我还是把它突破了。

鉴于本站的热情及本人的事先承诺,我将此首发于此并上传网站仅发于此。如有引用,请原文引用。

'以下是窗体内的代码:

Option Explicit

'********************************************
'*第一步:声明 窗体TestFrm,类模块TestChk,框架Frame1,Treeview、ImageList控件
'********************************************

'*--------------------------------------------------------------------------------*
'*1、数据源声明
'*在VBA内使用一个Frame控件代替VB内的两个Picture控件实现试题的滚动显现
'*引入:
'*类库:Microsoft windows Common Controls6.0(sp6)
'*位置(Windows标准库):system32\Mscomctl.ocx
'*类库:Microsoft ActiveX Data Objects 2.0 Library
'*位置:program files\common files\system\ado\msado20.tlb
'*--------------------------------------------------------------------------------*
Public strAddCnl As String '客户解答试题的控件类名称,初始时设定
Public SumItem As Integer '试题的总数量,在VB中string和integer可以自动转换,为保持数值类型的一致性这里设置为string型
Public intLstItem As Integer '上次获得焦点的试题题号,功能是辅助调整试题在Grame1里的位置
Public intCurCnlSerial As Integer '试题编号,初始为0

Private CnlSerialFrt As String '第一个试题第一个选项控件的后缀编号
Private cnlfrt As String '第一个标题的编号(TabIdex属性)
Private ItemNOCur As String '当前试题的题号,当前试题是第几道题的标示
Private CurItemCnl As String '当前选项在当前试题的序号

Private dbconnect As New ADODB.Connection
Private rs As New ADODB.Recordset

'*--------------------------------------------------------------------------------*
'*2、声明自动添加的控件变量,循环计数器;以两重循环语句分别设计试题的题目的选项
'*--------------------------------------------------------------------------------*
Private WithEvents labObject As Label
Private WithEvents chkObject As CheckBox

Private i, j As Integer '内外循环计数器

'*------------------------------------------------------------------------------*
'*3、确定自动添加的控件的相关参数
'*------------------------------------------------------------------------------*
Public nOpn As Integer '选项数目,在UserForm_Initialize事件的行首设置值
Const WidthRubric = 250 '题目长度,即Label控件对象的长度
Const WidthOptn = 240 '放置选项的checkbox控件的最大长度
Const VDistance = 4
Const HDistance = 5
Const LeftDistance = 5
Const LeftAppend = 20
Const topini = 40

Private WidthOptnExt As Integer '选项显示的实际长度
Private nLstChkTop As Integer '当前Checkbox的Top,计算下一控件的Top


'使动态添加的控件可用的关键是必须每个控件都有相关事件,
'要实现这一步,我们要先定义一个类TestChk,
'用这个类来设定每一个添加的CheckBox控件的事件;然后,
'设置动态数组来对每个试题选项所用控件添加代码,重新定义见(2)
Private MyChkCLS() As New TestChk

Private ValSquare As Integer '调正值

'*----------------------------------------------------------------------------*
'*退出用户自定义表单
'*----------------------------------------------------------------------------*
Private Sub CommandButton2_Click()
MsgBox "这段时间,工作、学习比较紧张 -------请大家见谅!" + Chr(13) + Chr(13) + _
"下节课,我们将一起来学习如何使标示排序" + Chr(13) + Chr(13) + _
Space(15) + "----把未作的试题列于顶部!" + Chr(13) + Chr(13) + _
Space(20) + "大家可以先试着做做。" + Chr(13) + Chr(13) + Chr(13) + Chr(13) + _
"提醒注意:本节代码未作优化。"

Unload TestFrm
End Sub

'--------------------------------------------------------------------------
'
'作个关联吧,既方便用户也使你的课件看起来更专业。
'-------------------------------------------------------------------------

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)

Dim strOldSer As String '存储改变题号前的试题控件编号,做题时修改上次做题的情况指示图像

Dim intTestNum, intSelTest As Integer '所选试题题号

Dim i As Integer
Dim BgnCnl As String
Dim EndCnl As String
Dim blnFnd As Boolean '上一步是否做题


''判断试题完成情况,变更左侧树内指示图像
If TestFrm.CurSerial(1) <> "" Then
BgnCnl = TestFrm.FstSerial(0) + (TestFrm.nOpn + 1) * (TestFrm.intCurCnlSerial - 1)
EndCnl = BgnCnl + TestFrm.nOpn - 1
For i = BgnCnl To EndCnl
If TestFrm.Frame1.Controls(i).Value = True Then
blnFnd = True
Exit For
End If
Next

If blnFnd = True Then
TestFrm.TreeView1.Nodes.Item(CInt(TestFrm.CurSerial(1))).Image = 3
Else
TestFrm.TreeView1.Nodes.Item(CInt(TestFrm.CurSerial(1))).Image = 1
End If
End If

intTestNum = TreeView1.SelectedItem.Index
intSelTest = intTestNum

If intTestNum = 1 Then

Frame1.Scroll , 5 '如果是第1道题滑块移至页首(纵向)
intTestNum = intTestNum * nOpn + intTestNum - 1 '注意:controls对象集合内的控件的Tabindex从0开始

Frame1.Controls(intTestNum).SetFocus

TestFrm.CurSerial(1) = Frame1.ActiveControl.Name

Else
intTestNum = intTestNum * nOpn + intTestNum - 1 '注意:controls对象集合内的控件的Tabindex从0开始

Frame1.Controls(intTestNum).SetFocus

'若上次所做试题的序号大于准备做的试题的序号,则先使焦点先置于将做试题之前,再返回。
'否则,标题无法显示。
TestFrm.CurSerial(1) = Frame1.ActiveControl.Name '当前试题题号

If TestFrm.CurSerial(1) < intCurCnlSerial Then

intTestNum = (intSelTest - 1) * nOpn + (intSelTest - 1) - 1

Frame1.Controls(intTestNum).SetFocus

intTestNum = intTestNum + nOpn + 1

Frame1.Controls(intTestNum).SetFocus

End If

End If

intCurCnlSerial = CInt(TestFrm.CurSerial(1))

TreeView1.Nodes.Item(intCurCnlSerial).Image = 2
 

End Sub

Private Sub UserForm_Initialize()

strAddCnl = "CheckBox" '要设置焦点的控件类别
Let nOpn = 4
intCurCnlSerial = 0

If dbconnect.State = adStateOpen And Not IsEmpty(adStateOpen) Then dbconnect.Close
dbconnect.Provider = "microsoft.jet.oledb.4.0" 'access 97 ois 3.51
dbconnect.ConnectionString = "data\function_chr.mdb"
dbconnect.Open

'若记录集已经打开关闭它
If rs.State = adStateOpen And Not IsEmpty(adStateOpen) Then rs.Close
rs.Open "chr", dbconnect, adOpenKeyset, adLockOptimistic
'*------------------------------------------------------------------------------------------------------------*
'*初始Imagelist1控件(添加两个图像表示该试题是否做过),TreeView1控件使用该图像控件内的图像集合设置节点显示图标
'*------------------------------------------------------------------------------------------------------------*
'wine提醒您:这里最好加上判断文件是否存在

ImageList1.ListImages.Add , , LoadPicture("bmp\atelic.ico")
ImageList1.ListImages.Add , , LoadPicture("bmp\edit.ico")
ImageList1.ListImages.Add , , LoadPicture("bmp\complete.ico")

'*初始TreeView1控件
With TreeView1
.Style = 3 'tvwTreeLinesPictureText
.ImageList = ImageList1 '在结点上显示图像
.LineStyle = 1 'tvwRootLines
.LabelEdit = 1 'tvwAutomatic
End With


Dim oNodx As String 'TreeView1的Node对象


'*---------------------------------------------------------------------*
'*定义自动添加的控件变量,以两重循环语句分别设计试题的题目的选项
'*---------------------------------------------------------------------*

SumItem = rs.RecordCount '试题总数

ReDim MyChkCLS(1 To SumItem * nOpn) '根据选项的数目重新定义Checkbox的变量----------(2)

For i = 1 To SumItem '外层设置试题题目

ValSquare = i - 1 '调正值。调正因添加Labobject对象给ChkObject对象在Frame1.controls内所造成的位置偏差

oNodx = TreeView1.Nodes.Add(, , , "第" & i & "道题", 1)

'若对象变量存在先撤销
If Not labObject Is Nothing Then 'IsEmpty(labObject) And Not
Set labObject = Nothing
End If

Set labObject = Frame1.Controls.Add("Forms.Label.1", , Visible)

'定义标题LabObject对象属性
With labObject
'................'......此处定义属性,详见第一课
End With
'定义标题对象的方法

'试题选项大于20个字符分两行,否则分四行
'..........


For j = 1 To nOpn '内层设置多选试题的选项

If Not labObject Is Nothing Then Set chkObject = Nothing 'Not IsEmpty(chkObject) And

Set chkObject = TestFrm.Frame1.Controls.Add("Forms.CheckBox.1", , Visible)
With chkObject
'......此处定义属性,详见第一课

End With



'取第一个选题控件(checkbox)的名称后缀数字
If i = 1 And j = 1 Then
TestFrm.FstSerial(0) = CStr(chkObject.TabIndex)
TestFrm.FstSerial(1) = chkObject.Name
End If

'绑定试题选项的事件为类的GetCon方法 -------------------(2)
MyChkCLS(nOpn * i - nOpn + j).GetCon Frame1.Controls(nOpn * i - nOpn + j + ValSquare)
Next


If Not rs.EOF Then rs.MoveNext

Next

With Frame1 '滚动范围
.ScrollHeight = 1.05 * nLstChkTop
'.ScrollWidth = 1.2 * Frame1.Width
End With

rs.Close
dbconnect.Close

End Sub

'**********************************************************
'定义表单属性SumItem、FstSerial 、 CurSerial
'**********************************************************
'1、试题总数量
'TestFrm.SumItem

'2、第一道试题的第一个选择项的控件后缀编号属性值
Public Property Get FstSerial(Optional getsel As Integer = 0) As String
If getsel = 0 Then
FstSerial = cnlfrt '第一个控件的编号(tabindex)
Else
FstSerial = CnlSerialFrt '第一个选项所用控件的名称编号
End If
End Property

Public Property Let FstSerial(Optional getsel As Integer = 0, oFrtCnl As String)
If getsel = 0 Then
cnlfrt = oFrtCnl
Else
Dim i As Integer
For i = 1 To Len(oFrtCnl) '首位若是字符val()返回值为0,与截取的字符串不相等
If Val(Mid(oFrtCnl, i)) = Mid(oFrtCnl, i) Then
CnlSerialFrt = Mid(oFrtCnl, i)
Exit For
End If
Next
End If
End Property

'3、当前试题的题号及当前控件的编号(Tabindex)
Public Property Get CurSerial(Optional getsel As Integer = 0) As String
If getsel = 0 Then
CurSerial = CurItemCnl '当前选项所用控件编号
Else
CurSerial = ItemNOCur '试题题号
End If
End Property


Public Property Let CurSerial(Optional getsel As Integer = 0, oCurCnl As String)
'参数getsel为0时,获取控件编号,为非0值时,获取当前题号;oCurCnl为当前控件的名称
Dim i As Integer
Dim varSer As Single

' getsel=0

If getsel = 0 Then
CurItemCnl = oCurCnl
Exit Property
End If

' getsel<>0

For i = 1 To Len(oCurCnl)
If Val(Mid(oCurCnl, i)) = Mid(oCurCnl, i) Then
ItemNOCur = Mid(oCurCnl, i)
Exit For
End If
Next
varSer = (ItemNOCur - TestFrm.FstSerial(1) + 1) / nOpn 'nOpn为每题预设的选项数目
If Fix(varSer) = varSer Then
ItemNOCur = CStr(varSer) '当前控件为每道题的最后一个选项使用的控件
Else
ItemNOCur = CStr(Fix(varSer) + 1)
End If

End Property


Private Sub UserForm_Terminate()

'撤销对象,释放资源
For i = 1 To SumItem
For j = 1 To nOpn
Set MyChkCLS(nOpn * i - nOpn + j) = Nothing
Next
Next

Set rs = Nothing
Set dbconnect = Nothing

End Sub

 

'源文出自:PPT学习论坛(www.PPTxx.com),原创作者:周生军来自中原油田
Option Explicit

Private WithEvents oTestChk As CheckBox

Public Sub GetCon(oCurcon As CheckBox)

'接受外部变量到oTestChk中
Set oTestChk = oCurcon

End Sub

'***********************************************************************
'完成以下功能:
'2、变更表单的数组变量ValueSave的值,以备存储学员的答案
'1、根据当前编辑的试题的题号变更Node对象的Image属性,作出堤示反映
'***********************************************************************

'下面是TestChk类模块的代码:

'

Private Sub oTestChk_Click()
Dim i As Integer
Dim BgnCnl As String
Dim EndCnl As String
Dim blnFnd As Boolean

'判断是否做题
'根据判断结果,变更试题解答情况指示图像
If Not TestFrm.CurSerial(1) = "" Then
BgnCnl = TestFrm.FstSerial(0) + (TestFrm.nOpn + 1) * (TestFrm.intCurCnlSerial - 1)
EndCnl = BgnCnl + TestFrm.nOpn - 1
For i = BgnCnl To EndCnl
If TestFrm.Frame1.Controls(i).Value = True Then
blnFnd = True
Exit For
End If
Next

If blnFnd = True Then '上一步已做试题
TestFrm.TreeView1.Nodes.Item(CInt(TestFrm.CurSerial(1))).Image = 3
Else
TestFrm.TreeView1.Nodes.Item(CInt(TestFrm.CurSerial(1))).Image = 1
End If
End If

'wine提示:实参在自定义属性中的作用。

'变更指示图像为编辑状态
' TestFrm.CurSerial(0) = oTestChk.Name '当前试题控件编号
TestFrm.CurSerial(1) = oTestChk.Name '当前试题题号

TestFrm.intCurCnlSerial = CInt(TestFrm.CurSerial(1))
TestFrm.TreeView1.Nodes.Item(TestFrm.intCurCnlSerial).Image = 2

TestFrm.intLstItem = TestFrm.intCurCnlSerial '把当前题号存储起来,作为下一个试题的前一试题

End Sub


一个好的程序,在考虑功能及效率的同时,得考虑如何方便用户。今天,我们来讲一讲如何对左侧的快捷框进行排序,使学员没有完成的试题显示于顶部,主要使用了TreeView控件的sorted属性。该属性如果设置为True,Node对象或TreeView的根会安照其Text属性内的文本的字母 (即ASCII码)排序。

这是我们的第三课,因为近来工作繁忙上传得迟了,请大家见谅。另外,马上要十一了,我打算出去放松一下。接下来的课程上传得十月中旬左右。

在这里,祝大家国庆节愉快!

言归正传,让我们打开上面在VB编辑器里做的试题界面,并添加一个命令按钮,名称为blnSort,其它属性自己定吧,方便美观就行。把下面的代码拷贝到代码区,运行。

Private Sub blnSort_Click()
Dim intNodNum As Integer

If blnSort.Caption = "排序" Then
blnSort.Caption = "复原"

For intNodNum = 1 To TreeView1.Nodes.Count
With TreeView1.Nodes(intNodNum)
If .Image = 1 Or .Image = 2 Then
.Text = " " & .Text
End If
End With
Next
TreeView1.Sorted = True
Else
blnSort.Caption = "排序"

For intNodNum = 1 To TreeView1.Nodes.Count
With TreeView1.Nodes(intNodNum)
If .Image = 1 Or .Image = 2 Then
.Text = LTrim(.Text)
End If
End With
Next
TreeView1.Sorted = True
End If
End Sub
'第三课结束
 

------分隔线----------------------------
标签(Tag):ppt PowerPoint技巧 ppt技巧 PowerPoint教程 幻灯片 poweroint poweroint技巧 PPT模板
------分隔线----------------------------
推荐内容
猜你感兴趣