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
相关推荐
相与还2 小时前
godot+c#操作sqlite并加解密
sqlite·c#·godot·sqlcipher
疯狂的维修2 小时前
关于Gateway configration studio软件配置网关
网络协议·c#·自动化·gateway
程序猿多布4 小时前
XLua教程之Lua调用C#
unity·c#·lua·xlua
唐青枫4 小时前
FluentData 从入门到精通:C#.NET 数据访问最佳实践
c#·.net
张晓~1833994812114 小时前
短视频矩阵源码-视频剪辑+AI智能体开发接入技术分享
c语言·c++·人工智能·矩阵·c#·php·音视频
almighty2716 小时前
C# DataGridView表头自定义设置全攻略
数据库·c#·winform·datagridview·自定义表头
星空的资源小屋16 小时前
Digital Clock 4,一款免费的个性化桌面数字时钟
stm32·单片机·嵌入式硬件·电脑·excel
arbboter17 小时前
【自动化】深入浅出UIAutomationClient:C#桌面自动化实战指南
运维·c#·自动化·inspect·uiautomation·uia·桌面自动化
文弱书生65618 小时前
5.后台运行设置和包设计与实现
服务器·开发语言·c#
大飞pkz1 天前
【设计模式】题目小练2
开发语言·设计模式·c#·题目小练