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

处理完数个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





已标记关键词 清除标记
相关推荐
©️2020 CSDN 皮肤主题: 编程工作室 设计师:CSDN官方博客 返回首页