word批量修改文字 vba vba word 选中文字
word批量修改, 在数字后面添加文字
示例代码如下：Sub 宏1()For i = 1 To ThisDocument.Tables.Counts = ThisDocument.Tables(i).Cell(1, 2).Range.TextIf Trim(s) = ＂＂ ThenMsgBox （＂无数据＂ & s）ElseMsgBox （＂有数据＂ & s）End IfNextEnd Sub
word 使用vba 怎么改一个内容？
操作步骤。
第一，首先将需要批量替换的多个Word文档放在同一文件夹下面。
第二，新建一空白Word文档，右击空白工具栏，单击“控件工具箱”，就可以看到屏幕上调出的控件工具箱。
第三，在控件工具箱上单击“命令按钮”，文档中就放置了一个按钮了。
第四，双击该按钮，进入VB代码编写模式，将以下代码复制进去。
Private Sub CommandButton1_Click()Application.ScreenUpdating = FalseDim myPas As String, myPath As String, i As Integer, myDoc As DocumentWith Application.FileDialog(msoFileDialogFolderPicker) .Title = ＂选择目标文件夹＂ If .Show = -1 Then myPath = .SelectedItems(1) Else Exit Sub End IfEnd WithmyPas = InputBox（＂请输入打开密码：＂）With Application.FileSearch .LookIn = myPath .FileType = msoFileTypeWordDocuments If .Execute > 0 Then For i = 1 To .FoundFiles.Count Set myDoc = Documents.Open(FileName:=.FoundFiles(i), Passworddocument:=myPas) Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = ＂大家好＂ .Replacement.Text = ＂你好＂ .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll myDoc.Save myDoc.Close Set myDoc = Nothing Next End IfEnd WithApplication.ScreenUpdating = TrueEnd Sub 第五，保存上面代码，退出VB编辑模式，返回Word文档界面。
第六，单击选中该按钮，再单击控件工具箱的第一个按钮“退出设计模式”。
第七，进行测试：点击按钮，选择要放置多个WORD文档所在的文件夹，确定后即可完成！注意如果WORD文档没有加密的话，密码项就不填，直接确认。
就会发现该文件夹下面的所有WORD文档中“大家好”已被替换为“你好”了。
WORD、高手们、宏、VBA、宏有关批量运行
Sub 批量操作WORD() Dim path As String Dim FileName As String Dim worddoc As Document Dim MyDir As String MyDir = ＂G:\360data\重要数据\桌面\新建文件夹 （2）＂ "文件夹路径根据需要自己修改，需要处理的文件都放该文件夹内 FileName = Dir(MyDir & ＂\*.doc*＂, vbNormal) Do Until FileName = ＂＂ If FileName ThisDocument.Name Then Set worddoc = Documents.Open(MyDir & ＂\＂ & FileName) worddoc.Activate Call 处理WORD "调用宏，换成你自己宏的名字 worddoc.Close True FileName = Dir() End If LoopSet worddoc = NothingEnd Sub"======================下面的宏换成你自己的宏=================================Sub 处理WORD() ActiveDocument.Paragraphs(1).Range.Select Selection.Font.Size = 72End Sub
Word中如何批量修改部分文字字体
打开文件，将文章全部选中，点击“编辑→替换”命令，打开“替换与查找”对话框，点击下面的“高级”按钮，再选中“使用通配符”选项；在“查找内容”中输入“*”，点击“替换为”，接着选择下面的“格式”，并选择“字体”选项，在弹出的“查找字体”对话框中将字体设置为“黑体”然后确定；最后选择“全部替换”，这样就可以一次性地将文章中在引号内的文字全部更换为黑体字。
...
word vba问题 如何批量替换文件夹内所有的WORD文档内相同的词组...
Sub 批量修改（）"On Error Resume NextDim FileOpenDim X As IntegerDim wb As WorkbookApplication.ScreenUpdating = FalseFileOpen = Application.GetOpenFilename(FileFilter:=＂Microsoft Excel文件（*.xls）,*.xls＂, MultiSelect:=True, Title：=＂选择工作薄＂）X = 1While X Set wb = Workbooks.Open(FileOpen(X))wb.Sheets(1).[a1] = ＂456＂wb.Sheets(1).[D4] = ＂王月＂wb.Close TrueX = X + 1WendEnd Sub这个宏 会把 你选中的文件 批量替换 sheet1 :A1的内容 改为 456 D4 的内容改为 王月， 你可以根据你的实际情况修改代码就可以了， 如果单元格不固定就 用FIND 方法找到再修改
Word中怎样批量修改文字格式样式
注：vba偶并不太熟（偶一般是用c#和delphi的），VBA只是稍有了解，以下代码大部分是偶google到的内容拼出来的。
。
。
。
。
如下，使用时先更改test下的docpath和xlspath路径设定，docpath即你的word的目录，此目录包括子目录下的所有doc将被读取，xlspath即输出目录，需要存在 在VBA窗口中，先在视图下显示立即窗口以观察进度，程序最后的输出类似这样 正在读取[1]:->D:\1\Resume.doc 正在生成：->d:\2\Resume 正在读取[2]:->D:\1\简历（简）.doc 正在生成：->d:\2\简历（简） 正在读取[3]:->D:\1\计数器说明.doc 正在生成：->d:\2\计数器说明 共耗时0分41秒 Option Explicit Dim docpath As String, xlspath As String"ResultFlag=0 获取路径"ResultFlag=1 获取文件名"ResultFlag=2 获取扩展名 Public Function SplitPath(FullPath As String, ResultFlag As Integer) As String Dim SplitPos As Integer, DotPos As Integer SplitPos = InStrRev(FullPath, ＂\＂) DotPos = InStrRev(FullPath, ＂.＂) Select Case ResultFlag Case 0 SplitPath = Left(FullPath, SplitPos - 1) Case 1 If DotPos = 0 Then DotPos = Len(FullPath) + 1 SplitPath = Mid(FullPath, SplitPos + 1, DotPos - SplitPos - 1) Case 2 If DotPos = 0 Then DotPos = Len(FullPath) SplitPath = Mid(FullPath, DotPos + 1) Case Else Err.Raise vbObjectError + 1, ＂SplitPath Function＂, ＂Invalid Parameter!＂ End Select End Function Public Function FileFolderExists(ByVal strFullPath As String) As Boolean On Error GoTo EarlyExit If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True EarlyExit: On Error GoTo 0 End Function Sub Test（) "使用双字典，旨在提高速度 Dim MyName, Dic, Did, I, T, F, TT, MyFileName, Doc, Ke Dim count As Integer count = 0 T = Time docpath = ＂D:\1\＂ xlspath = ＂d:\2\＂ Set Dic = CreateObject(＂Scripting.Dictionary＂) "创建一个字典对象 Set Did = CreateObject(＂Scripting.Dictionary＂) Dic.Add (docpath), ＂＂ I = 0 Do While I Ke = Dic.keys "开始遍历字典 MyName = Dir(Ke(I), vbDirectory） "查找目录 Do While MyName ＂＂ If MyName ＂.＂ And MyName ＂..＂ Then If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then "如果是次级目录 Dic.Add (Ke(I) & MyName & ＂\＂）， ＂＂ "就往字典中添加这个次级目录名作为一个条目 End If End If MyName = Dir "继续遍历寻找 Loop I = I + 1 Loop "Did.Add （＂文件清单＂）， ＂＂ "以查找D盘下所有EXCEL文件为例 For Each Ke In Dic.keys MyFileName = Dir(Ke & ＂*.doc＂) Do While MyFileName ＂＂ Doc = Ke & MyFileName Did.Add (Doc), ＂＂ count = count + 1 Debug.Print ＂正在读取[＂ & count & ＂]:->＂ & Doc doc2xls (Doc) MyFileName = Dir Loop Next " For Each Sh In ThisWorkbook.Worksheets " If Sh.Name = ＂XLS文件清单＂ Then " Sheets(＂XLS文件清单＂).Cells.Delete " F = True " Exit For " Else " F = False " End If " Next "If Not F Then " Sheets.Add.Name = ＂XLS文件清单＂ "End If "Sheets(＂XLS文件清单＂).[A1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys) TT = Time - T Debug.Print ＂共耗时＂ & Minute(TT) & ＂分＂ & Second(TT) & ＂秒＂ End Sub Sub doc2xls(filename As String) Dim xlApp As Object, xlSheet As Object, outfile As String, c As Object Set xlApp = CreateObject(＂Excel.Application＂) Set xlSheet = xlApp.Workbooks.Add.Sheets(1) Dim Wapp As Object, Doc As Object, GetDocText As Object "Word Application 对象、Document 对象 Set Wapp = CreateObject(＂Word.Application＂) "创建Word Application 对象 Set Doc = Wapp.Documents.Open(filename, ReadOnly:=True) "打开文档，返回一个文档对象"xlSheet.Range(＂A1＂) = Doc.Content.Text Doc.Application.Selection.WholeStory """"全选 Doc.Application.Selection.Copy """"""""""复制 xlSheet.Range(＂A1＂).Select xlSheet.Paste outfile = xlspath + Replace(SplitPath(filename, 1), ＂.doc＂, ＂.xls＂) Debug.Print ＂正在生成：->＂ & outfile xlSheet.Parent.SaveAs outfile xlApp.Quit Set xlSheet = Nothing Set xlApp = Nothing Wapp.Quit Set Doc = Nothing Set Wapp = Nothing End Sub
- 上一篇：串口显示波形软件 串口波形软件
- 下一篇：app预测软件 最精准的竞彩app预测
-