Foxtable(狐表)用户栏目专家坐堂 → 如何把字典中的文件与WORD一一匹配和替换?


  共有1998人关注过本帖树形打印复制链接

主题:如何把字典中的文件与WORD一一匹配和替换?

帅哥哟,离线,有人找我吗?
南望
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:392 积分:3312 威望:0 精华:0 注册:2014/4/9 10:04:00
如何把字典中的文件与WORD一一匹配和替换?  发帖心情 Post By:2020/12/18 17:13:00 [只看该作者]

想把EXCEL文件中(词典,两列N多行)一 一匹配到WORD,找到符合的就替换,请问题老师下列代码咋改?不会了。
Dim dic As new Dictionary(of String,String)
Dim dicfile As String =  Forms("WORD工具").Controls("TextBox4").value
Dim Book As New XLS.Book(dicfile) '定义一个Excel工作簿
Dim Sheet As XLS.Sheet = Book.Sheets(0) '引用工作簿的第一个工作表
For i As Integer = 0 To Sheet.Rows.Count-1
If dic.ContainsKey(Sheet(i, 0).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) = False Then
dic.add(Sheet(i, 0).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""),Sheet(i, 1).Text)
End If
Next

For Each file As String In FileSys.GetFiles(path)

    Dim Ifo As new FileInfo(file)
    If (file.EndsWith(".doc") OrElse file.EndsWith(".rtf") OrElse file.EndsWith(".docx") OrElse file.EndsWith(".DOC") OrElse file.EndsWith(".RTF") OrElse file.EndsWith(".DOCX")) AndAlso Ifo.hidden = False Then
        Dim app As New MSWord.Application
        try
            Dim doc = app.Documents.Open(file)
            'For Each k As object In Doc.Paragraphs
            
            app.Selection.Find.ClearFormatting
            app.Selection.Find.Replacement.ClearFormatting
            With app.Selection.Find
                .Text = "委托合同"
                .Replacement.Text = "委托合同" & Chr(13) & "WeiTuoHeTong"
                .Forward = True
                .Wrap = MSWord.WdFindWrap.wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchByte = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            app.Selection.Find.Execute(Replace:= MSWord.WdReplace.wdReplaceAll)
            'app.Visible = True
            doc.save()
            app.quit
            'Next
            'doc.save()
            'app.quit
        catch ex As exception
            msgbox(ex.message)
            app.quit
        End try
    End If
Next

[此贴子已经被作者于2020/12/18 17:13:49编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
南望
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:小狐 帖子:392 积分:3312 威望:0 精华:0 注册:2014/4/9 10:04:00
  发帖心情 Post By:2020/12/18 17:14:00 [只看该作者]

现在单个替换好使,如何根据EXCEL批量替换?

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:107147 积分:544978 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2020/12/18 17:21:00 [只看该作者]

for each key   as string in dic.keys
           app.Selection.Find.ClearFormatting
            app.Selection.Find.Replacement.ClearFormatting
            With app.Selection.Find
                .Text = "委托合同"
                .Replacement.Text = dic(key)
                .Forward = True
                .Wrap = MSWord.WdFindWrap.wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchByte = True
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            app.Selection.Find.Execute(Replace:= MSWord.WdReplace.wdReplaceAll)
next

 回到顶部