Public Function wordfs()
On Error Resume Next
Dim wordscore As Integer
Dim wordApp As New Word.Application
Dim wordDoc As Word.Document
Dim i As Integer, N As Integer, flag As BooleanSet wordApp = GetObject("Word.Application")
If wordApp = Null Then
    Set wordApp = CreateObject("Word.Application")
End IfSet wordDoc = wordApp.Documents.Open(App.Path & "\考生" & kskh & "\word" & Arraynum(1) & ".doc", , False)
Select Case Arraynum(1)
Case 5001
'比较字体,字型
If wordDoc.Paragraphs(1).Range.Font.Name = "黑体" And _
   wordDoc.Paragraphs(1).Range.Font.Size = 14 And _
   wordDoc.Paragraphs(1).Range.Font.Underline = wdUnderlineSingle And _
   wordDoc.Paragraphs(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter Then
       wordscore = wordscore + 3
End If
N = wordDoc.Paragraphs.Count
flag = False
For i = 2 To N
If wordDoc.Paragraphs(i).Range.Font.Name = "宋体" And _
   wordDoc.Paragraphs(i).Range.Font.Size = 12 And _
   wordDoc.Paragraphs(i).Range.ParagraphFormat.LineSpacingRule = wdLineSpaceDouble Then
        flag = True
Else
        flag = False
End If
Next i
If flag = True Then
    wordscore = wordscore + 3
End If'查找替换操作
flag = False
'For i = 1 To N
If Selection.Find.Text = "我国" And _
   Selection.Find.Replacement.Text = "中国" And _
   Selection.Find.Execute(Replace:=wdReplaceAll) Then
        flag = True
Else
        flag = False
    
End If
'Next i
If flag = True Then
    wordscore = wordscore + 3
End If'比较页眉
If ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader And _
     wordDoc.Selection(Text:="可爱的边疆") And _
     wordDoc.Selection.ParagraphFormat.Alignment = wdAlignParagraphRight Then
        wordscore = wordscore + 3
   
End If'比较字间距
If wordDoc.Paragraphs(7).Range.Font.Spacing = 2 And _
   wordDoc.Paragraphs(7).Range.Font.Scaling = 100 Then
        wordscore = wordscore + 3
End If
……
case 5002
……
End Selectwordfs = wordscore
Set wordDoc = Nothing
 wordApp.Quit '关闭WORD程序
 Set wordApp = Nothing
End Function