PPT中自动阅卷的实现

<script type="text/javascript">function StorePage(){d=document;t=d.selection?(d.selection.type!='None'?d.selection.createRange().text:''):(d.getSelection?d.getSelection():'');void(keyit=window.open('http://www.365key.com/storeit.aspx?t='+escape(d.title)+'&u='+escape(d.location.href)+'&c='+escape(t),'keyit','scrollbars=no,width=475,height=575,left=75,top=20,status=no,resizable=yes'));keyit.focus();}</script>         因单位要求，帮镇工会组织的“2008迎奥运，计算机操作竞赛”出试题。主要内容有打字、Word操作、Excel操作和PPT操作。由于参加竞赛的人员 较多，不可能为每一位选手手工评分，所以用Office中的VBA来实现各个模块试题的自动评分。现将各部分操作题目及VBA程序贴出。

PPT中实现自动评分
以下是PPT中的题目

l

打开PowerPoint,制作一个简单课件,内容为八荣八耻。要求如下：

1、选用crayons.pot设计模板并应用于所有模板，将所有幻灯片的背景预设为“雨后初晴”、垂直。

2、将第3页标题“八荣八耻，从我做起”设置为黑体，96号；插入背景音乐《八荣八耻歌 童声版》，设置为自动播放，循环播放。
3、第4张幻灯片为目录，分别设置其超级链接到相关的位置
标题按钮：链接到标题页
童谣按钮：链接到童谣内容页面
内涵按钮：链接到内涵内容页面
网站按钮：链接到网站：
http://www.southcn.com/nflr/llzhuanti/rrg/


4、设置幻灯片切换方式：

第3张：切换效果为“菱形”，换页方式为“单击鼠标”，声音为“照相机”；

以下是PPT自动阅卷VBA代码：
'// No 1
If ActivePresentation.TemplateName = "Crayons" Then
Score = Score + 4
ErrStr = "第1题：模板“设置正确" & vbCrLf
Else
ErrStr = "第1题：模板“设置错误" & vbCrLf
End If


With ActivePresentation.TitleMaster.Background
If .Fill.ForeColor.RGB = RGB(94, 158, 255) And .Fill.BackColor.RGB = RGB(255, 235, 250) Then
    Score = Score + 4
ErrStr = ErrStr & "第1题“背景”设置正确" & vbCrLf
Else
ErrStr = ErrStr & "第1题“背景”设置错误" & vbCrLf
End If
End With

With ActivePresentation.TitleMaster.Background
If .Fill.GradientStyle = msoGradientVertical And .Fill.GradientVariant = 1 _
   And .Fill.PresetGradientType = msoGradientDaybreak Then
   Score = Score + 4
ErrStr = ErrStr & "第1题“垂直”设置正确" & vbCrLf
Else
ErrStr = ErrStr & "第1题“垂直”设置错误" & vbCrLf
End If
End With
  
'// No 2
With ActivePresentation.Slides(3).Shapes(1).TextFrame.TextRange.Font

If .Size = 96 Then
   Score = Score + 2
ErrStr = ErrStr & "第2题“字号”设置正确" & vbCrLf
Else
ErrStr = ErrStr & "第2题“字号”设置错误" & vbCrLf
End If
If .NameFarEast = "黑体" Then
   Score = Score + 2
ErrStr = ErrStr & "第2题“字体”设置正确" & vbCrLf
Else
ErrStr = ErrStr & "第2题“字体”设置错误" & vbCrLf
End If

End With


On Error Resume Next
shp = ActivePresentation.Slides(3).Shapes(2).MediaType

If Err <> 0 Then
   Score = Score
   ErrStr = ErrStr & "第2题“声音”设置错误" & vbCrLf
Else
  If shp = ppMediaTypeSound Then
   Score = Score + 4
  ErrStr = ErrStr & "第2题“声音”设置正确" & vbCrLf
  Else
  ErrStr = ErrStr & "第2题“声音”设置错误" & vbCrLf
  End If
End If

'// No 3
If ActivePresentation.Slides(4).Shapes(2).ActionSettings(ppMouseClick).Action = ppActionPreviousSlide Then
   Score = Score + 4
   ErrStr = ErrStr & "第3题“标题链接”设置正确" & vbCrLf
Else
   ErrStr = ErrStr & "第3题“标题链接”设置错误" & vbCrLf
End If

If ActivePresentation.Slides(4).Shapes(3).ActionSettings(ppMouseClick).Action = ppActionNextSlide Then
   Score = Score + 4
  ErrStr = ErrStr & "第3题“童谣链接”设置正确" & vbCrLf
Else
  ErrStr = ErrStr & "第3题“童谣链接”设置错误" & vbCrLf
End If

If ActivePresentation.Slides(4).Shapes(4).ActionSettings(ppMouseClick).Hyperlink.SubAddress = _
   "260,6," + ChrW$(CharCode:=8220) + "八荣八耻" + ChrW$(CharCode:=8221) + "的内涵是什么？" Then
   Score = Score + 4
  ErrStr = ErrStr & "第3题“内涵链接”设置正确" & vbCrLf
Else
  ErrStr = ErrStr & "第3题“内涵链接”设置错误" & vbCrLf
End If

If ActivePresentation.Slides(4).Shapes(5).ActionSettings(ppMouseClick).Hyperlink.Address = "http://www.southcn.com/nflr/llzhuanti/rrg/" Then
   Score = Score + 4
  ErrStr = ErrStr & "第3题“网址链接”设置正确" & vbCrLf
Else
  ErrStr = ErrStr & "第3题“网址链接”设置错误" & vbCrLf
End If


'// No 4
On Error Resume Next
shp = ActivePresentation.Slides(3).SlideShowTransition.SoundEffect.Name
If Err <> 0 Then
   Score = Score
   ErrStr = ErrStr & "第4题“切换”设置错误" & vbCrLf
Else
With ActivePresentation.Slides(3).SlideShowTransition
If .EntryEffect = ppEffectDiamondOut And _
   .AdvanceOnClick = msoTrue And _
   shp = "camera.wav" Then
  Score = Score + 4
  ErrStr = ErrStr & "第4题“切换”设置正确" & vbCrLf
Else
  ErrStr = ErrStr & "第4题“切换”设置错误" & vbCrLf
End If
End With
End If



'MsgBox (ErrStr & vbCrLf & "您的分数是： " & Score)
MsgBox ("您的分数是： " & Score)