批量替换word文字公式帮忙修改

linguipeng85

老师，用“批量替换word文字小工具”要将文件夹多个word的文字进行替换，文件没有文本框的都没问题，就是文本框里面的词改不了，不知道为什么，比如：“揭阳市特牛科技有限公司”替换成：“揭阳市123科技有限公司”，第2跟5个文本框里面的字就改不了
先打开批量替换word文字小工具

然后


第2跟5个文本框里面的字就改不了
求大神帮忙改下“批量替换word文字小工具”的公式

zldccmx

zldccmx

1. Private Sub CommandButton1_Click()
   
2.     Application.ScreenUpdating = False
   
3.     Dim myFile$, myPath$, i%, myDoc As Object, myAPP As Object, txt$, Re_txt$, Sp
   
4.     Set myAPP = CreateObject("word.application")
   
5.     With Application.FileDialog(msoFileDialogFolderPicker)
   
6.         .Title = "选择目标文件夹"
   
7.         If .Show = -1 Then
   
8.             myPath = .SelectedItems(1)
   
9.         Else
   
10.             Exit Sub
    
11.         End If
    
12.     End With
    
13.     myPath = myPath & "":    myFile = Dir(myPath & "*.doc*")
    
14.     txt = InputBox("需要替换的文字：")
    
15.     Re_txt = InputBox("替换成：")
    
16.     'myAPP.Visible = True '是否显示打开文档
    
17.     Do While myFile <> ""
    
18.         Set myDoc = myAPP.Documents.Open(myPath & myFile)
    
19.         If myDoc.ProtectionType = wdNoProtection Then    '是否受保护
    
20.             With myDoc.Content.Find
    
21.                 .Text = txt
    
22.                 .Replacement.Text = Re_txt
    
23.                 .Forward = True
    
24.                 .Wrap = 2
    
25.                 .Format = False: .MatchCase = False
    
26.                 .MatchWholeWord = False
    
27.                 .MatchByte = True
    
28.                 .MatchWildcards = False
    
29.                 .MatchSoundsLike = False
    
30.                 .MatchAllWordForms = False
    
31.                 .Execute Replace:=2
    
32.             End With
    
33. Rem ------------------------------------------------------------------------------------------------------
    
34.             '替换文本框中的文字                                                                          |
    
35.             For Each Sp In myDoc.Shapes '                                                                |
    
36.                 If Sp.TextFrame.TextRange.Text Like "*" & txt & "*" Then '                               |
    
37.                     Sp.TextFrame.TextRange.Text = Replace(Sp.TextFrame.TextRange.Text, txt, Re_txt) '    |
    
38.                 End If '                                                                                 |
    
39.             Next '                                                                                       |
    
40.             '替换结束'                                                                                   |
    
41. Rem ------------------------------------------------------------------------------------------------------
    
42.         End If
    
43.         myDoc.Save: myDoc.Close
    
44.         myFile = Dir
    
45.     Loop
    
46.     myAPP.Quit    '关掉临时进程
    
47.     Application.ScreenUpdating = True
    
48.     MsgBox ("全部替换完毕！")
    
49. End Sub
    

复制代码