EXCEL VBA将word里面的指定的关键词替换掉后并标记红色字体

EXCEL VBA将word里面的指定的关键词替换掉后并标记红色字体

python 复制代码
Sub 开关()
Call 新建副本
Call ReplaceAndHighlightInFolder
End Sub
Sub 新建副本()
    fpath = ThisWorkbook.Path & "\"
    Dim MyFile As Object
    Set MyFile = CreateObject("Scripting.FileSystemObject")
    MyFile.CopyFolder fpath & "\待处理文档", ThisWorkbook.Path & "\处理后的标红的文档"
    Set MyFile = Nothing
End Sub


Sub ReplaceAndHighlightInFolder()
t = Time()
    Dim folderPath As String
    Dim excelApp As Object
    Dim excelWorkbook As Object
    Dim sheet As Object
    Dim rng As Object
    Dim findText As String
    Dim replaceText As String
    
    fpath = ThisWorkbook.Path & "\"
    
    Set sheet = ThisWorkbook.Worksheets(1)
    
    folderPath = fpath & "处理后的标红的文档\"

    
    ' 遍历Excel表格,进行替换和标红

                ' 遍历文件夹中的所有文档
        Dim objFSO As Object
        Dim objFolder As Object
        Dim objFile As Object
        
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFolder = objFSO.GetFolder(folderPath)
        Dim wordApp As Object
        Dim wordDoc As Object
        
        ' 打开Word应用
        Set wordApp = CreateObject("Word.Application")
        wordApp.Visible = True
        For Each objFile In objFolder.Files
            If objFSO.GetExtensionName(objFile.Name) = "docx" Or objFSO.GetExtensionName(objFile.Name) = "doc" Then ' 只处理docx文件

                
                ' 打开Word文档
                Set doc = wordApp.Documents.Open(objFile.Path)
                
                For Each rng In sheet.Range("A1:A" & sheet.Cells(sheet.Rows.Count, "A").End(-4162).Row)
                    replaceWord = rng.Value
                    replaceWith = rng.Offset(0, 1).Value
 
                ' 遍历文档中的每个段落,进行替换和标红

                
                ' 获取当前活动的文档
                
                ' 从文档的开头开始查找需要替换的词
                   Set findRange = doc.Range
    
                    ' 开始查找并替换
                    With findRange.Find
                        .Text = replaceWord
                        .MatchCase = True
                        .MatchWholeWord = True
                        Do While .Execute
                            If findRange.Text = replaceWord Then
                                findRange.Text = replaceWith
                                findRange.Font.Color = RGB(255, 0, 0)
                            End If
                            findRange.Collapse Direction:=wdCollapseEnd
                        Loop
                    End With
                Next
                                
                
                
                
                ' 保存并关闭Word文档
                doc.Save
                doc.Close
                
                ' 释放Word对象
                Set doc = Nothing
                
            End If
        Next objFile
    
    wordApp.Quit
    
    
    MsgBox "替换完成,耗时" & DateDiff("s", t, Time()) & "秒"
End Sub
相关推荐
小码编匠13 小时前
WPF 中的高级交互通过右键拖动实现图像灵活缩放
后端·c#·.net
唐青枫20 小时前
C#.NET 定时任务与队列利器:Hangfire 完整教程
c#·.net
hez20101 天前
Runtime Async - 步入高性能异步时代
c#·.net·.net core·clr
葡萄城技术团队2 天前
从100秒到10秒的性能优化,你真的掌握 Excel 的使用技巧了吗?
excel
mudtools2 天前
.NET驾驭Word之力:玩转文本与格式
c#·.net
唐青枫2 天前
C#.NET 数据库开发提速秘籍:SqlSugar 实战详解
c#·.net
mudtools2 天前
.NET驾驭Word之力:理解Word对象模型核心 (Application, Document, Range)
c#·.net
玩泥巴的2 天前
.NET驾驭Word之力:理解Word对象模型核心 (Application, Document, Range)
word·二次开发·office·com互操作
大飞pkz3 天前
【设计模式】C#反射实现抽象工厂模式
设计模式·c#·抽象工厂模式·c#反射·c#反射实现抽象工厂模式
QQ3596773453 天前
ArcGIS Pro实现基于 Excel 表格批量创建标准地理数据库(GDB)——高效数据库建库解决方案
数据库·arcgis·excel