在另一个文档中查找某字符

xupuhyl

各位老师，本人对word vb完全不懂，请老师们帮我看看附件中的这一查找如何写代码，谢谢！

413191246se

楼主未写明会不会用宏？给你一个宏，会用不？

xupuhyl

谢谢楼上的关心，我会用宏，偶尔用excel宏编点小程序，对word宏真是陌生，请帮助我，谢谢！

413191246se

楼主，请同时打开如你附件中的两个WORD文档，文件名不要改变，然后执行下面的宏：（此宏放到 Normal.dot中即可，如你要求的放到文档中，我不大会，也不喜欢，你随便录制一个宏，如 Macro1，然后在《工具》菜单---宏----宏-----中找到它，编辑之，再在它下面拷贝下面的宏即可）
Sub 查找入声字()
    Dim i As String, j As Long
    Windows("待验诗词").Activate
    Selection.EndKey unit:=wdStory
    Selection.TypeText Text:="`"
    Selection.HomeKey unit:=wdStory
    Do
        Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
        i = Selection.Text
        If i Like "[。，；：！]" Then GoTo skip
        Windows("常用入声字歌诀").Activate
        Selection.HomeKey unit:=wdStory
        Selection.ClearFormatting
        Selection.Find.Execute findtext:=i
        If Selection.Find.Found = True Then j = 1 Else j = 0
        Windows("待验诗词").Activate
        If j = 1 Then Selection.Font.Color = wdColorRed: Selection.Font.Bold = True
skip:
        Selection.MoveRight unit:=wdCharacter, Count:=1
    Loop Until Selection.Text = "`"
End Sub

xupuhyl

非常感谢老师，这几天用账号登录不了，迟迟不能上来道谢，见谅！
另外，如果能在后台打开常用入声字歌诀，验证完以后在后台自动关闭，这样更方便，我试了几次都没有成功。如何才能实现？

413191246se

楼主，你好！请在最后一句 End Sub 上面一行添加：
Windows("常用入声字歌诀").Close

xupuhyl

谢谢
你程序里的设计： Windows("常用入声字歌诀").Activate是在打开状态后激活这一文档。
我想让程序在后台自动打开常用入声字歌诀.doc这个文件，免得每次手动打开。

413191246se

楼主，这回再试试！（注意——代码中假设把《歌诀》这个文档放在了 d:\我的文档 文件夹中了，如果不同，你自己修改一下吧！另外，这个文档要永久放在一处，不要改变才能反复用此代码！）
Sub aaa查找入声字()
    ActiveDocument.SaveAs FileName:=ActiveDocument.Path & "\" & Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) & "_入声" & ".doc" '创建副本
    Dim i As String, j As Long, a As String, b As String, c As String, e As Long
    a = ActiveDocument.FullName
    b = "d:\我的文档\常用入声字歌诀.doc" '歌诀完整文件名（如果路径不同，请自行修改！只此一处！）
    Documents.Open FileName:=b
    e = InStrRev(b, "\")
    c = Mid(b, e + 1)
    c = Left(c, Len(c) - 4)
    Windows(a).Activate
    Selection.EndKey unit:=wdStory
    Selection.TypeText Text:="`"
    Selection.HomeKey unit:=wdStory
    Do
        Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
        i = Selection.Text
        If i Like "[。，；：！]" Then GoTo skip
        Windows(c).Activate
        Selection.HomeKey unit:=wdStory
        Selection.ClearFormatting
        Selection.Find.Execute findtext:=i
        If Selection.Find.Found = True Then j = 1 Else j = 0
        Windows(a).Activate
        If j = 1 Then Selection.Font.Color = wdColorRed: Selection.Font.Bold = True
skip:
        Selection.MoveRight unit:=wdCharacter, Count:=1
    Loop Until Selection.Text = "`"
    Windows(c).Close savechanges:=wdDoNotSaveChanges
    ActiveDocument.Characters.Last.Previous.Delete
    ActiveDocument.Close savechanges:=wdSaveChanges
    Documents.Open FileName:=a
    MsgBox "处理完毕！当前文档已经保存！", vbOKOnly + vbExclamation, "查找入声字"
End Sub

xupuhyl

老师您好，这几天忙没有上来。
感谢你重新编写了，我希望直接在待验的这个文件中做标红标记，不要另存副本。

第二：我按您的公式调试，发现   Windows(c).Activate这一语句出问题，说集合成员不存在。
请您再看看。谢谢！

413191246se

楼主，请你确认一下你的《歌诀》文件，是在 C:\My Documents\ 文件夹还是 C:\我的文档\ 文件夹，请自行修改第 5 行代码路径：

1. Sub aaa查找入声字()
   
2.     On Error Resume Next
   
3.     Dim i As String, j As Long, oldName As String, docName As String, chkName As String
   
4.     oldName = ActiveDocument.FullName
   
5.     docName = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)
   
6.     Documents.Open FileName:="C:\My Documents\常用入声字歌诀.doc"
   
7.     chkName = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4)
   
8.     Documents(docName).Activate
   
9.     Selection.EndKey unit:=wdStory
   
10.     Selection.TypeText Text:="`"
    
11.     Selection.HomeKey unit:=wdStory
    
12.     Do
    
13.         Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
    
14.         i = Selection.Text
    
15.         If i Like "[。，；：！]" Then GoTo skip
    
16.         Documents(chkName).Activate
    
17.         Selection.HomeKey unit:=wdStory
    
18.         Selection.ClearFormatting
    
19.         Selection.Find.Execute findtext:=i
    
20.         If Selection.Find.Found = True Then j = 1 Else j = 0
    
21.         Documents(docName).Activate
    
22.         If j = 1 Then Selection.Font.Color = wdColorRed: Selection.Font.Bold = True
    
23. skip:
    
24.         Selection.MoveRight unit:=wdCharacter, Count:=1
    
25.     Loop Until Selection.Text = "`"
    
26.     Documents(chkName).Close savechanges:=wdDoNotSaveChanges
    
27.     ActiveDocument.Characters.Last.Previous.Delete
    
28.     ActiveDocument.Close savechanges:=wdSaveChanges
    
29.     Documents.Open FileName:=oldName
    
30.     MsgBox "处理完毕！当前文档已经保存！", vbOKOnly + vbExclamation, "查找入声字"
    
31. End Sub

复制代码