|
设计思路：
鉴于楼主提供的文档已初具不规范，谁知，一上手设计代码，才知道，其两个文档间的不规范，杂出其间，“惨不忍睹”。因此，我能做的，只有以下的代码，除非楼主规范文档的格式，否则，继续运行是不可能的，因为，你的两个文档，已是人脑都难以分清了，何况电脑！
部分问题，我在代码的注释中，已经写进去了；部分问题，你可以看一下我的附件，这是代码运行的结果，你看一下，很多段落因为两个文档的不同处理方式，导致了WORD判断错误！
我能做的：将所有不规范或者无碍于判断的空格、小圆圈、中文标点、英文标点（你看一下你的两个文档，中英文标点杂出其间！）、序数词后缀与编号等等，不堪入目！
在排除了以上干扰后，电脑依据该段落的净文本在标准文档中，是否存在，如果不存在，则红色显示，反之，不处理。
实际上，如果楼主规范文档要求，则以下代码修改后，置于标准文档的代码窗口中，在指定文件夹下遍历每个作业文档，进行电脑批阅。
以下代码供参考：
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-6-26 6:16:59
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Sub WorksCompare()
Dim StandardDoc As Document, aPara As Paragraph, strApar As String
Dim strStandardDoc As String, ChineseInterpunction As Variant, EnglishInterpunction As Variant
Dim aArray As Variant, ParLabel As String
'你的文档太不规范了!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'先定义一个中文标点数组
ChineseInterpunction = Array(" ", "。", "，", "；", "：", "？", "！", "……", "—", "～", "〔", "〕", "《", "》", "‘", "’", "“", "”")
'定义一个英文标点数组
EnglishInterpunction = Array(".", ",", ";", ":", "?", "!", "…", "-", "~", "(", ")", "<", ">", "'", """")
'定义一个段首标志字符串
ParLabel = "一二三四五六七八九十1234567890"
'定义一个标准文档DOCUMENT对象
Set StandardDoc = Documents("第四次作业答案.doc")
'将所有的空格全部去除
strStandardDoc = VBA.Trim(StandardDoc.Content)
'对标准文档的字符串进行长达三十多次的循环替换,原因只是相互间标点符号不兼容!!!!
For Each aArray In ChineseInterpunction
strStandardDoc = VBA.Replace(strStandardDoc, aArray, "")
Next
For Each aArray In EnglishInterpunction
strStandardDoc = VBA.Replace(strStandardDoc, aArray, "")
Next
Application.ScreenUpdating = False
'将作业文档中的带小圈的字符全部替换掉!!!!
With ThisDocument.Content.Find
.ClearFormatting
.Text = " "
.Execute replacewith:="", Replace:=wdReplaceAll
End With
'在遍历作业文档的每一个段落
For Each aPara In ThisDocument.Paragraphs
'定义一个段落字符串变量,为去除空格后的段落文本
strApar = VBA.Trim(aPara.Range)
'如果不是空白段落
If Len(strApar) > 1 Then
'如果其段首字符不是序数词,你看一下,自己的序号,有"、"的有"。"的!!!
If VBA.InStr(ParLabel, aPara.Range.Characters.First.Text) = 0 Then
'将该段落中的字符串(已除空格),再进行三十多次的循环替换,将其间的标点符号全部去除
For Each aArray In ChineseInterpunction
strApar = VBA.Replace(strApar, aArray, "")
Next
For Each aArray In EnglishInterpunction
strApar = VBA.Replace(strApar, aArray, "")
Next
'所有只有文本的内容,如果在标准文档的字符串中,不存在,则改为红色
If VBA.InStr(strStandardDoc, strApar) = 0 Then
' MsgBox strApar
aPara.Range.Font.Color = wdColorRed
End If
End If
End If
Next
'恢复屏幕更新
Application.ScreenUpdating = True
End Sub
'----------------------
huYJXtWq.rar
(11.07 KB, 下载次数: 45)
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-6-25 11:18
楼主