用VBA检查两文档的不同之处

ke3088 · 发表于 2018-4-8 16:56

文档经修改后，格式、文字可能发生变化，想在原稿用VBA代码检查与修改稿的不同之处，即：原稿的第1段与修改稿的第1段相比，字符稍有丁点不同，原稿整段字体为红色，第2段与第2段相比，第3段与第3段比……直至文档末段，段落如有不同，原稿的相应段落标红。
向各位大师求救。谢谢

ming0018 · 发表于 2018-4-9 08:27

友情提示：无附件，会被骂的。

iamadsl · 发表于 2018-4-9 11:46

感觉挺复杂的，需要判断的地方太多，你还是老老实实用ＷＤ自带的对比吧。。。当然，我也期待有大神发个牛Ｘ的代码上来~

ke3088 · 发表于 2018-4-9 20:45

期待大神出手

ke3088 · 发表于 2018-4-11 23:42

本帖最后由 ke3088 于 2018-4-12 08:24 编辑

运行速度慢点都没关系，只要能达到目的就行

413191246se · 发表于 2018-4-15 02:39

楼主，我也试着编了一个《文稿比较》的小宏，但测试后觉得有些不甚满意，但没办法，有热情，有干劲，就是水平低，请试用（不行就删除）：

Sub test文稿比较()
If MsgBox("请注意：修改稿文件名必须是《修改稿》三个字！原稿文件名不必改。" & vbCr & _
"请打开原稿和修改稿，然后必须将光标放在原稿中才能应用此宏，否则出错！-->工具/宏/宏/test文稿比较" & vbCr & vbCr & _
"是否继续？ (处理需要时间，请耐心等待一会儿！)", vbYesNo + vbCritical) = vbNo Then End
Dim y$, a As Document, b As Document, i&, j&, k&, x&, m&, n&, u&, v&
y = ActiveDocument.Name
Set a = Documents(y)
Set b = Documents("修改稿.doc")
With b
With .Content.Find
.Execute "^13", , , 0, , , , , , "^p", 2
.Execute "^11", , , 0, , , , , , "^p", 2
.Parent.ListFormat.ConvertNumbersToText
End With
.Select
CommandBars.FindControl(ID:=122).Execute
CommandBars.FindControl(ID:=123).Execute
With Selection.Font
.Size = 16
.Color = wdColorAutomatic
End With
End With
With a
With .Content.Find
.Execute "^13", , , 0, , , , , , "^p", 2
.Execute "^11", , , 0, , , , , , "^p", 2
.Parent.ListFormat.ConvertNumbersToText
End With
.Select
CommandBars.FindControl(ID:=122).Execute
CommandBars.FindControl(ID:=123).Execute
With Selection.Font
.Size = 16
.Color = wdColorAutomatic
End With
j = .Paragraphs.Count
k = b.Paragraphs.Count
If j > k Then x = k Else x = j
For i = 1 To x
u = Len(.Paragraphs(i).Range)
v = Len(b.Paragraphs(i).Range)
Do
m = m + 1
n = n + 1
If m > u Then Exit Do
If n > v Then Exit Do
If .Paragraphs(i).Range.Characters(m).Text = b.Paragraphs(i).Range.Characters(n).Text Then
.Paragraphs(i).Range.Characters(m).Font.Color = wdColorBlue
b.Paragraphs(i).Range.Characters(n).Font.Color = wdColorBlue
Else
If u > v Then
.Paragraphs(i).Range.Characters(m).Font.Color = wdColorRed
n = n - 1
ElseIf u < v Then
b.Paragraphs(i).Range.Characters(n).Font.Color = wdColorRed
m = m - 1
Else
.Paragraphs(i).Range.Characters(m).Font.Color = wdColorRed
b.Paragraphs(i).Range.Characters(n).Font.Color = wdColorRed
End If
End If
Loop
m = 0
n = 0
Next i
End With
MsgBox "处理完毕！！！！！！！！！！！！", 0 + 48
Selection.HomeKey unit:=wdStory
Windows.CompareSideBySideWith "修改稿"
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 用VBA检查两文档的不同之处

评分