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
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
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货