因单位要求,帮镇工会组织的“2008迎奥运,计算机操作竞赛”出试题。主要内容有打字、Word操作、Excel操作和PPT操作。由于参加竞赛的人员 较多,不可能为每一位选手手工评分,所以用Office中的VBA来实现各个模块试题的自动评分。现将各部分操作题目及VBA程序贴出。
Word中实现打字测试自动评分
打字的内容:
href="file:///C:%5CDOCUME%7E1%5CADMINI%7E1%5CLOCALS%7E1%5CTemp%5Cmsohtml1%5C01%5Cclip_filelist.xml" rel="File-List" /> href="file:///C:%5CDOCUME%7E1%5CADMINI%7E1%5CLOCALS%7E1%5CTemp%5Cmsohtml1%5C01%5Cclip_editdata.mso" rel="Edit-Time-Data" />
'以下是自动评分代码:
'说明:由于在word中实现打字测试功能,则必须禁止在word中的复制功能,'''包括右键、编辑菜单及工具栏中的复制,还有快捷键Ctrl+C等,这样才能保证'选手在操作过程中只能打字输入!
'=====================
'以下是禁止复制等内容
'=====================
Private Sub Document_Close()
With Application
.CommandBars("Edit").Controls("复制(&c)").Enabled = True
.CommandBars("File").Controls("另存为(&a)...").Enabled = True '另存为菜单按钮失效
.CommandBars("Standard").Controls("复制(&c)").Enabled = True
.CommandBars("Text").Enabled = True
End With
End Sub
Private Sub Document_Open()
With Application
'.OnKey Key = "^c", procedure:="dd"
.CommandBars("Edit").Controls("复制(&c)").Enabled = False '复制菜单按钮失效
.CommandBars("File").Controls("另存为(&a)...").Enabled = False '另存为菜单按钮失效
.CommandBars("Standard").Controls("复制(&c)").Enabled = False '复制工具按钮失效
.CommandBars("Text").Enabled = False '右键菜单失效
End With
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyControl, wdKeyC), KeyCategory:=wdKeyCategoryCommand, _
Command:="dd" '使用ctrl+c则运行dd
End Sub
Sub dd()
MsgBox "呵呵!不能复制哦!"
End Sub
'==================
'以下是评分内容
'==================
Private Sub CommandButton1_Click()
Dim Score As Single
Dim i, j, sl, dl As Integer
s = pswdInputBox()
If s = 8415002 Then
Score = 0
l = 0
For i = 2 To 48 Step 2
sl = Len(ActiveDocument.Paragraphs(i).Range.Text)
dl = Len(ActiveDocument.Paragraphs(i + 1).Range.Text)
If sl > dl Then
For j = 1 To dl
If ActiveDocument.Paragraphs(i).Range.Characters(j).Text = _
ActiveDocument.Paragraphs(i + 1).Range.Characters(j).Text Then
Score = Score + 0.1
End If
Next j
Else
For j = 1 To sl
If ActiveDocument.Paragraphs(i).Range.Characters(j).Text = _
ActiveDocument.Paragraphs(i + 1).Range.Characters(j).Text Then
Score = Score + 0.1
End If
Next j
End If
Next i
MsgBox ("您的分数是: " & Int(Score))
End If
End Sub
Word中实现打字测试自动评分
打字的内容:
href="file:///C:%5CDOCUME%7E1%5CADMINI%7E1%5CLOCALS%7E1%5CTemp%5Cmsohtml1%5C01%5Cclip_filelist.xml" rel="File-List" /> href="file:///C:%5CDOCUME%7E1%5CADMINI%7E1%5CLOCALS%7E1%5CTemp%5Cmsohtml1%5C01%5Cclip_editdata.mso" rel="Edit-Time-Data" />
(共62分)
是沙巴·冯的,写的很不错,好东西和大家一起分享@^_^%
岁月
当办公室后面的小河一再膨胀时,我知道,丰沛的雨季又来
了。不过这一季的雨水来得特别早,出乎我的意料,使我
没有准备去承受这一场雨季的湿润,洗涤我岁月的长衫。太
平洋上的风姑娘,欣然接受北婆罗洲莽莽苍林的邀请,夹着
一条长长的水带,翩然来到北婆罗洲的上空,洒下清泉万丈,
让热情奔放的处女林,显露着救旱逢甘露的喜悦。在岁月的
长河里,我摆一叶轻舟,从我生命的源头起航。河的两岸,
有桃红柳绿的葱茏簇拥,互争艳丽;也有骨排楼宇的森林,
穿插在其间:更有暗礁潜伏在激流当中,让我的旅途充满崎
岖和不安。激流中,也许会错过停泊的岸头,才能觅得柳暗
花明。人的一生中,难免错失良机,与幸运失之交臂。我的
小舟,就常常在岁月的长河中漂流。 这一场雨季,扑打在
我的窗口,敲响我每一场梦境中的时钟狂嚼着我的梦,这才
发现我的梦境如此苦涩难咽,便把破碎的梦吐在破玻璃上让
碎片模糊我的视线。我在河流上很很触了礁。而风,仍不肯
停歇,依然在广阔无垠的星宇下旋舞,旋舞。舞的精彩,舞
的狂乱。我只好遂一拾起被震碎的梦境,想一副拼图游戏,
以颤抖的双手,拼贴生命。风,仍不肯停歇,任性着舞动者
风云。岁月的长河被舞的惊涛骇浪,而我仍摆一叶轻舟,冲
破云头,使向前方。我不怕被覆舟。我更不怕颠簸我只想证
明我不是一个渡客。小河,每天都在膨胀。 雨水的丰沛,
是造成小河膨胀的现象。河里的鱼群,在简陋的洞口闪着。
'以下是自动评分代码:
'说明:由于在word中实现打字测试功能,则必须禁止在word中的复制功能,'''包括右键、编辑菜单及工具栏中的复制,还有快捷键Ctrl+C等,这样才能保证'选手在操作过程中只能打字输入!
'=====================
'以下是禁止复制等内容
'=====================
Private Sub Document_Close()
With Application
.CommandBars("Edit").Controls("复制(&c)").Enabled = True
.CommandBars("File").Controls("另存为(&a)...").Enabled = True '另存为菜单按钮失效
.CommandBars("Standard").Controls("复制(&c)").Enabled = True
.CommandBars("Text").Enabled = True
End With
End Sub
Private Sub Document_Open()
With Application
'.OnKey Key = "^c", procedure:="dd"
.CommandBars("Edit").Controls("复制(&c)").Enabled = False '复制菜单按钮失效
.CommandBars("File").Controls("另存为(&a)...").Enabled = False '另存为菜单按钮失效
.CommandBars("Standard").Controls("复制(&c)").Enabled = False '复制工具按钮失效
.CommandBars("Text").Enabled = False '右键菜单失效
End With
KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyControl, wdKeyC), KeyCategory:=wdKeyCategoryCommand, _
Command:="dd" '使用ctrl+c则运行dd
End Sub
Sub dd()
MsgBox "呵呵!不能复制哦!"
End Sub
'==================
'以下是评分内容
'==================
Private Sub CommandButton1_Click()
Dim Score As Single
Dim i, j, sl, dl As Integer
s = pswdInputBox()
If s = 8415002 Then
Score = 0
l = 0
For i = 2 To 48 Step 2
sl = Len(ActiveDocument.Paragraphs(i).Range.Text)
dl = Len(ActiveDocument.Paragraphs(i + 1).Range.Text)
If sl > dl Then
For j = 1 To dl
If ActiveDocument.Paragraphs(i).Range.Characters(j).Text = _
ActiveDocument.Paragraphs(i + 1).Range.Characters(j).Text Then
Score = Score + 0.1
End If
Next j
Else
For j = 1 To sl
If ActiveDocument.Paragraphs(i).Range.Characters(j).Text = _
ActiveDocument.Paragraphs(i + 1).Range.Characters(j).Text Then
Score = Score + 0.1
End If
Next j
End If
Next i
MsgBox ("您的分数是: " & Int(Score))
End If
End Sub