关于“word操作题自动评分”

[plmqaz1029]

有没有人有代码啊， 刚接触这些不是很懂啊 网上关于word vba的知识又比较少。。。。求大神帮忙。。。谢谢了

[plmqaz1029]

1、将全文中的所有“《经济学家》”设为粗体，蓝色。

2、将正文各段的行间距设置为1.5倍行距。

3、在正文的最后一段的“在很多大企业中，现在……”这一句前插入“另外，”

最新一期英国《经济学家》周刊载文预测，随着手持电脑、电视机顶置盒、智能移动电话、网络电脑等新一代操作简易、可靠性高的计算装置的迅速兴起，在未来五年中，个人电脑在计算机产业中的比重将不断下降，计算机发展史上个人电脑占主导地位的时代行将结束。

该杂志引用国际数据公司最近发表的一份预测报告称，虽然目前新一代计算装置的销量与个人电脑相比还微不足道，但其销售速度在今后几年内将迅猛增长，在2002年左右其销量就会与个人电脑基本持平，此后还将进一步上升。以此为转折点，个人电脑的主导时代将走向衰落。

《经济学家》分析认为，个人电脑统治[1]地位的岌岌可危与个人电脑的发展现状有很大关系。对一般并不具备多少电脑知识的个人用户来说，现在的个人电脑操作显得过于复杂；而对很多企业用户来说，个人电脑单一的功能也无法满足迅速发展的网络电子商务对计算功能专门化、细分化的要求。
在很多大企业中，现在常常采用个人电脑与功能强大的中央电脑相连的工作模式，在很多时候也造成不便和混乱。
例如上面这个操作题 要怎么实现他的自动评分啊

[threenewbee]

思路就是你调用VBA去判断这些地方是否设置正确了。

资料少不要紧，只要你分享你的工资，还是有人能分享他的代码的。

[赵4老师]

在Word2003中开始记录宏，手动完成所需功能，结束记录宏，按Alt+F11键，查看刚才记录的宏对应的VBA代码。

[jsyxlhj]

是要判断文章中设置得对不对（老师评卷）还是要用代码使文档达到这个样子？

[jsyxlhj]

Sub WordPF()
Dim WordFS As Single
With Documents("word.doc")

'第1题评分
.Select
With Selection.Find
.Text = "非机"
End With
If Not Selection.Find.Execute Then
With Selection.Find
.Text = "飞机"
.Format = True
.Font.EmphasisMark = wdEmphasisMarkOverSolidCircle
End With
Do While Selection.Find.Execute
n = n + 1
Loop
If n = 15 Then WordFS = WordFS + 2
End If

'第2题评分
If .Paragraphs(1).Alignment = wdAlignParagraphCenter Then WordFS = WordFS + 0.5
If .Paragraphs(1).Range.Font.Name = "楷体_GB2312" Then WordFS = WordFS + 0.5
If .Paragraphs(1).Range.Font.Size = 16 Then WordFS = WordFS + 0.5
If .Paragraphs(1).Range.Font.Color = wdColorBlue Then WordFS = WordFS + 0.5
If .Paragraphs(1).Range.Font.Borders(1).Color = wdColorBlue And .Paragraphs(1).Range.Font.Borders.Shadow = True Then WordFS = WordFS + 1

'第3题评分
With .PageSetup
If .PaperSize = wdPaperA4 Then
If CInt(.PageWidth) = CInt(CentimetersToPoints(21)) And CInt(.PageHeight) = CInt(CentimetersToPoints(29.7)) Then WordFS = WordFS + 1
End If
If CInt(.TopMargin) = CInt(CentimetersToPoints(2)) Then WordFS = WordFS + 0.25
If CInt(.BottomMargin) = CInt(CentimetersToPoints(2)) Then WordFS = WordFS + 0.25
If CInt(.LeftMargin) = CInt(CentimetersToPoints(2.5)) Then WordFS = WordFS + 0.25
If CInt(.RightMargin) = CInt(CentimetersToPoints(2)) Then WordFS = WordFS + 0.25
If .MirrorMargins = True Then WordFS = WordFS + 1
End With

'第4题评分
.Select
With Selection.Find
.Text = "拐上起飞跑道"
.Execute
End With
n = Selection.Start
.Select
With Selection.Find
.Text = "良好局面。"
.Execute
End With
m = Selection.End
Dim rngDOc As Range
Set rngDOc = .Range(n, m)
With rngDOc.ParagraphFormat
If CInt(.LineSpacing) = CInt(LinesToPoints(1.2)) Then WordFS = WordFS + 0.5
If .CharacterUnitFirstLineIndent = 2 Then WordFS = WordFS + 1
If .LineUnitAfter = 0.5 Then WordFS = WordFS + 0.5
End With
Set rngDOc = Nothing

'第5题评分
n = .Tables.Count
If n = 1 Then
Dim rn As Paragraph
Dim DocTab As Table
Set DocTab = .Tables(1)
If DocTab.Columns.Count = 4 And DocTab.Rows.Count = 3 Then WordFS = WordFS + 1 '表格三行四列正确
If DocTab.Columns(1).Width = 56.7 And DocTab.Columns(2).Width = 56.7 Then WordFS = WordFS + 0.5 ' "第1 2列宽为2厘米"
If DocTab.Columns(3).Width = 85.05 And DocTab.Columns(4).Width = 85.05 Then WordFS = WordFS + 0.5 ' "第3 4列宽为3厘米"
If DocTab.Rows.Alignment = wdAlignRowCenter Then WordFS = WordFS + 0.5 ' "表格居中对齐正确"
If DocTab.Range.Paragraphs.Alignment = wdAlignRowCenter Then WordFS = WordFS + 0.5 '表格内文字居中"
Set rn = Nothing
Set DocTab = Nothing
End If


'第6题评分
If .Shapes.Count = 1 Then
If CInt(.Shapes(1).Height) = 142 And CInt(.Shapes(1).Width) = 214 Then WordFS = WordFS + 2 '图片插入正确
.Shapes(1).RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.Shapes(1).RelativeVerticalPosition = wdRelativeVerticalPositionPage
If .Shapes(1).Left = wdShapeCenter And .Shapes(1).Top = wdShapeCenter Then WordFS = WordFS + 1 '图片位置设置正确
End If



' 第7题评分
If .Paragraphs(2).Range.ListFormat.ListString = "$" Then WordFS = WordFS + 1 '项目符号字符为$正确
If .Paragraphs(2).Range.ListFormat.ListValue = 1 Then WordFS = WordFS + 1
' MsgBox "编号：" & .Paragraphs(2).Range.ListFormat.ListValue & vbCrLf & "格式：" & .Paragraphs(2).Range.ListFormat.ListString

' 第8题评分 '因为首字下沉后本身就是一个段落
If .Paragraphs(3).DropCap.LinesToDrop = 2 Then WordFS = WordFS + 1 '首字下沉2行
If .Paragraphs(3).DropCap.FontName = "黑体" Then WordFS = WordFS + 0.5 '设置的字体正确
If .Paragraphs(3).DropCap.DistanceFromText = 0 Then WordFS = WordFS + 0.5 '设置的下沉汉了与正文间距为0

End With
Dim fso As New FileSystemObject
If fso.FolderExists(Documents("word.doc").Path & "\sys") Then
Open Documents("word.doc").Path & "\sys\CJword.dat" For Output As #1
Print #1, WordFS
Close #1
Else
MsgBox WordFS
End If
End Sub


这是我针对我的WORD文档做的一个评分代码，自己参考一下