word vba遍历文件，打开另外word修改保存

最新推荐文章于 2024-05-29 08:38:46 发布

dzweather

最新推荐文章于 2024-05-29 08:38:46 发布

阅读量1.1w

点赞数

CC 4.0 BY-SA版权

分类专栏： office 文章标签： word vba 遍历修改保存

本文链接：https://blog.youkuaiyun.com/dzweather/article/details/49386633

office 专栏收录该内容

6 篇文章

订阅专栏

本文提供了一个使用VBA处理Word文档的脚本，该脚本能够识别并修正文档中的符号错误，将大于等于和小于等于符号的位置进行互换，确保文档内容的正确性。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

处理完数个word，回头一看，才发现前面代码把一个符号搞反了。。。

把大于等于与小于等于两符号，颠倒了位置。。。晕。

马上用vba处理一下。

把这些word放在D盘根目录。逐个遍历并打开，逐一修改保存退出。OK！

代码如下：

Sub a()
    Dim doc As Document, myFile As String
    Dim a As Range
    
    myFile = Dir("D:\" & "*.docx")
    
    Do While myFile <> ""
        myFile = "D:\" & myFile
        Set doc = Documents.Open(myFile)
        Set a = doc.Range


        Selection.WholeStory
        '展开域
        Selection.Fields.ToggleShowCodes
        '≥≤ 把大换小，把小换小
        a.Find.Execute FindText:="≤", MatchWildcards:=True, replacewith:="$", Replace:=wdReplaceAll
        a.Find.Execute FindText:="≥", MatchWildcards:=True, replacewith:="#", Replace:=wdReplaceAll
        a.Find.Execute FindText:="$", MatchWildcards:=True, replacewith:="≥", Replace:=wdReplaceAll
        a.Find.Execute FindText:="#", MatchWildcards:=True, replacewith:="≤", Replace:=wdReplaceAll
        Selection.WholeStory
        Selection.Fields.ToggleShowCodes
        
        '保存退出
        doc.Save
        doc.Close
        
        Set doc = Nothing
        
        '查找下一个
        myFile = Dir
    Loop
End Sub

Sub a()
    Dim doc As Document, myFile As String
    Dim a As Range
    
    myFile = Dir("D:\" & "*.docx")
    Do While myFile <> ""
        myFile = "D:\" & myFile
        Set doc = Documents.Open(myFile)
        Set a = doc.Range
        
        Selection.WholeStory
        '展开域
        Selection.Fields.ToggleShowCodes
        '域调整
        a.Find.Execute FindText:="\s( ,", MatchWildcards:=False, replacewith:="\s\do6(", Replace:=wdReplaceAll
        a.Find.Execute FindText:="\s(", MatchWildcards:=False, replacewith:="\s\up7(", Replace:=wdReplaceAll
        Selection.WholeStory
        Selection.Fields.ToggleShowCodes
        
        Dim c As Range, strText As String
        '下标用域
        For Each c In a.Characters
            If c.Font.Subscript = True Then
                c.Select
                strText = Replace(c.Text, Chr(13), "")
                If strText <> "" Then
                    c.Delete
                    Set myfield = Selection.Fields.Add(Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=True) '增加一个新域
                    myfield.Code.Text = "eq \s\do4(" & strText & ")"
                Else
                    c.Font.Subscript = False
                End If
            End If
        Next
        
        '保存退出
        doc.Save
        doc.Close
        Set doc = Nothing
        '查找下一个
        myFile = Dir
    Loop
End Sub