word——VBA编程「建议收藏」

发布时间:2025-12-09 14:16:53 浏览次数:4

最近需要批量操作一些word文件,大约四十几个文件把。一个一个手动操作真的太low了,所以研究了一下word的宏,VBA编写代码,批量操作。
操作就是全选Word内容,给整体加一个书签PO_table。
选中文档中检测二字,加书签PO_jc。
选中 年 月 日,删除该选中内容。

Sub 批量操作WORD()Dim path          As StringDim FileName  As StringDim worddoc   As DocumentDim MyDir       As StringMyDir = "C:\Users\CSY\Documents\Tencent Files9023706\FileRecv\平台需要的\平台需要的"  '文件夹路径根据需要自己修改,需要处理的文件都放该文件夹内FileName = Dir(MyDir & "\*.docx*", vbNormal)Do Until FileName = ""If FileName <> ThisDocument.Name Then        Set worddoc = Documents.Open(MyDir & "\" & FileName)        worddoc.Activate        Call my  '调用宏,换成你自己宏的名字        worddoc.Close True        FileName = Dir()    End IfLoopSet worddoc = NothingEnd SubSub my()    Selection.WholeStory '全选    Options.DefaultHighlightColorIndex = wdNoHighlight    Selection.Range.HighlightColorIndex = wdNoHighlight '背景色设无    Selection.Font.Color = vbBlack '字体颜色设黑        Dim strBookmark As String '声明    strBookmark = "PO_table" '赋值    ActiveDocument.Bookmarks.Add Name:=strBookmark, Range:=Selection.Range '给选中区域设置书签        With Selection.Find        .Text = "检测:"        .Replacement.Text = ""        .Forward = True        .Wrap = wdFindContinue        .Format = False        .MatchCase = True        .MatchWholeWord = False        .MatchByte = False        .MatchAllWordForms = False        .MatchSoundsLike = False        .MatchWildcards = False        .MatchFuzzy = True    End With '选中文档中文字'检测:'    Selection.Find.Execute '选中执行    Selection.MoveRight Unit:=wdCharacter, Count:=1 '移动光标一格    strBookmark = "PO_jc"    ActiveDocument.Bookmarks.Add Name:=strBookmark, Range:=Selection.Range        With Selection.Find        .Text = "     年   月   日 "        .Replacement.Text = ""        .Forward = True        .Wrap = wdFindContinue        .Format = False        .MatchCase = True        .MatchWholeWord = False        .MatchByte = False        .MatchAllWordForms = False        .MatchSoundsLike = False        .MatchWildcards = False        .MatchFuzzy = True    End With '找到     年   月   日    Selection.Find.Execute    Selection.Delete'删除选中内容End Sub
需要做网站?需要网络推广?欢迎咨询客户经理 13272073477