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

来源：互联网发布：期货套利知乎编辑：程序博客网时间：2024/05/16 05:10

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

0 0