Jeśli masz kilkadziesiąt plików ze słowami, które zawierają tę samą zawartość (na przykład nagłówek, stopka, kilka specjalnych słów lub liczba) i musisz zamienić tę samą zawartość w tych dokumentach w programie Word. Jak byłoby ci łatwiej zrobić to szybko? Z pewnością możesz otwierać te pliki jeden po drugim, aby zastąpić tę samą zawartość, ale będzie to czasochłonne i kłopotliwe. Ten samouczek pokaże ci trudny sposób na zastąpienie tej samej treści w wielu dokumentach w programie Word jednocześnie.
Znajdź i zamień teksty w wielu dokumentach tekstowych w tym samym czasie za pomocą kodu VBA
1. naciśnij inny + F11 otworzyć Microsoft Visual Basic for Applications okno.
2. w Microsoft Visual Basic for Applications okno, kliknij wstawka > Moduł, a następnie skopiuj następujący kod VBA do okna Module.
Kod VBA: wyszukiwanie i zastępowanie tej samej treści w wielu dokumentach jednocześnie
Sub CommandButton1_Click()
'Updated by Extendoffice 20180625
Dim xFileDialog As FileDialog, GetStr(1 To 100) As String '100 files is the maximum applying this code
Dim xFindStr As String
Dim xReplaceStr As String
Dim xDoc As Document
On Error Resume Next
Set xFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With xFileDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.docx", 1
.AllowMultiSelect = True
i = 1
If .Show = -1 Then
For Each stiSelectedItem In .SelectedItems
GetStr(i) = stiSelectedItem
i = i + 1
Next
i = i - 1
End If
Application.ScreenUpdating = False
xFindStr = InputBox("Find what:", "Kutools for Word", xFindStr)
xReplaceStr = InputBox("Replace with:", "Kutools for Word", xReplaceStr)
For j = 1 To i Step 1
Set xDoc = Documents.Open(FileName:=GetStr(j), Visible:=True)
Windows(GetStr(j)).Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = xFindStr 'Find What
.Replacement.Text = xReplaceStr 'Replace With
.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
Application.Run macroname:="NEWMACROS"
ActiveDocument.Save
ActiveWindow.Close
Next
Application.ScreenUpdating = True
End With
MsgBox "Operation end, please view", vbInformation
End Sub
3. wciśnij F5 klucz do uruchomienia kodu.
4. W otwarciu Przeglądaj znajdź i wybierz dokumenty, które znajdziesz i zamień tekst w środku, a następnie kliknij OK przycisk. Zobacz zrzut ekranu:
5. W pierwszym Kutools dla Worda W oknie dialogowym wprowadź tekst, który znajdziesz w dokumentach do pliku Znajdź co a następnie kliknij OK przycisk.
6. W sekundę Kutools dla Worda wprowadź tekst, który chcesz zamienić, i kliknij OK przycisk.
8. Kliknij OK przycisk w następnym Microsoft Word okno dialogowe, aby zakończyć wyszukiwanie i zamianę.
W tym przypadku wszystkie słowa „Word” w wybranych dokumentach są jednocześnie zastępowane słowami „Excel”.
Łatwo znajduj i zamieniaj różne teksty w wielu dokumentach w tym samym czasie za pomocą Kutools for Word
Tutaj bardzo polecam Znajdź i zamień partii cechą Kutools dla Worda. Dzięki tej funkcji możesz łatwo znajdować i zastępować różne teksty w wielu dokumentach Word w tym samym czasie. Zobaczmy, jak zastosować tę funkcję, aby znaleźć i zamienić teksty w dokumentach.
1. Proszę kliknąć Kutools Plus > Znajdź i zamień partii aby włączyć tę funkcję.
2. w Znajdź i zamień partii okno dialogowe, skonfiguruj w następujący sposób.
2.1) Kliknij Dodaj wiersz przycisk pod Znajdowanie i zamienianie patka;
2.2) W utworzonych polach wierszy:
A. Wprowadź tekst, który znajdziesz w polu tekstowym w Znajdź kolumna B. Wpisz tekst, którym chcesz zastąpić, w polu tekstowym w zastąpić kolumna; C. Określ typ wyszukiwania, gdzie znaleźć tekst i kolor, aby wyróżnić tekst według potrzeb. W tym przypadku wybieram Pełne dopasowanie słów, Główny dokument i określony kolor z Typ wyszukiwania,Znaleźć w i Atrakcja kolumny;
2.3) Powtórz kroki 2.1 i 2.2, aby dodać więcej tekstów, które znajdziesz i zastąpisz;
2.4) Kliknij przycisk w Typ Pliku sekcja, aby dodać dokumenty Worda, w których znajdziesz i zamieniasz teksty;
2.5) Kliknij zastąpić or Znajdź przycisk. Zobacz zrzut ekranu:
Uwagi:
1. Jeśli klikniesz Znajdź wszystkie wyniki wyszukiwania zostaną wyświetlone pod przyciskiem Wynik podglądu patka. Po przejrzeniu wyników, jeśli chcesz zamienić wszystkie teksty, kliknij Znajdowanie i zamienianie patka. W przeciwnym razie zamknij okno dialogowe.
2. Jeśli klikniesz zastąpić przycisk, wszystkie określone teksty zostaną natychmiast zastąpione nowymi, a wyniki będą również wyświetlane pod Wynik podglądu patka.
3. Jeśli określisz kolory podświetlenia w kroku 2, wszystkie zastąpione teksty zostaną wyróżnione określonymi kolorami i można je łatwo znaleźć na pierwszy rzut oka w dokumentach.
3. Zamknij Znajdź i zamień partii Okno dialogowe
Aby uzyskać więcej informacji na temat tej funkcji, proszę Kliknij tutaj....
Jeśli chcesz skorzystać z bezpłatnej wersji próbnej tego narzędzia, przejdź do bezpłatnie pobrać oprogramowanie najpierw, a następnie przejdź do wykonania operacji zgodnie z powyższymi krokami.
Zalecane narzędzia zwiększające produktywność programu Word
This is SUCH a time saving solution. THANK YOU! One thing that may make it even better, is adding support for subdirectories. (That is: Files in multiple subdirectories) I am an absolute newbie in this, and don't know the syntax, the parameter, or where to add that.
Hi Tiago,
Please apply the below VBA code to include the content of headers and footers when finding and replacing texts in multiple documents at once.
Sub CommandButton1_Click()
'Updated by Extendoffice 20180625
Dim xFileDialog As FileDialog, GetStr(1 To 100) As String '100 files is the maximum applying this code
Dim xFindStr As String
Dim xReplaceStr As String
Dim xDoc As Document
On Error Resume Next
Set xFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With xFileDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.docx", 1
.AllowMultiSelect = True
i = 1
If .Show = -1 Then
For Each stiSelectedItem In .SelectedItems
GetStr(i) = stiSelectedItem
i = i + 1
Next
i = i - 1
End If
Application.ScreenUpdating = False
xFindStr = InputBox("Find what:", "Kutools for Word", xFindStr)
xReplaceStr = InputBox("Replace with:", "Kutools for Word", xReplaceStr)
For j = 1 To i Step 1
Set xDoc = Documents.Open(FileName:=GetStr(j), Visible:=True)
Windows(GetStr(j)).Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = xFindStr 'Find What
.Replacement.Text = xReplaceStr 'Replace With
.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
Application.Run macroname:="NEWMACROS"
If MsgBox("Do you want to replace texts in headers and footers too? ", vbYesNo, "Kutools for Word") = vbYes Then
ActiveWindow.View.SplitSpecial = wdPanePrimaryFooter
Selection.Find.Execute Replace:=wdReplaceAll
Application.Run macroname:="NEWMACROS"
ActiveWindow.View.SplitSpecial = wdPanePrimaryHeader
Selection.Find.Execute Replace:=wdReplaceAll
Application.Run macroname:="NEWMACROS"
End If
ActiveDocument.Save
ActiveWindow.Close
Next
Application.ScreenUpdating = True
End With
MsgBox "Operation end, please view", vbInformation
End Sub
Hi,
Please apply the below VBA code to include the content of headers and footers when finding and replacing texts in multiple documents at once.
Sub CommandButton1_Click()
'Updated by Extendoffice 20180625
Dim xFileDialog As FileDialog, GetStr(1 To 100) As String '100 files is the maximum applying this code
Dim xFindStr As String
Dim xReplaceStr As String
Dim xDoc As Document
On Error Resume Next
Set xFileDialog = Application.FileDialog(msoFileDialogFilePicker)
With xFileDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.docx", 1
.AllowMultiSelect = True
i = 1
If .Show = -1 Then
For Each stiSelectedItem In .SelectedItems
GetStr(i) = stiSelectedItem
i = i + 1
Next
i = i - 1
End If
Application.ScreenUpdating = False
xFindStr = InputBox("Find what:", "Kutools for Word", xFindStr)
xReplaceStr = InputBox("Replace with:", "Kutools for Word", xReplaceStr)
For j = 1 To i Step 1
Set xDoc = Documents.Open(FileName:=GetStr(j), Visible:=True)
Windows(GetStr(j)).Activate
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = xFindStr 'Find What
.Replacement.Text = xReplaceStr 'Replace With
.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
Application.Run macroname:="NEWMACROS"
If MsgBox("Do you want to replace texts in headers and footers too? ", vbYesNo, "Kutools for Word") = vbYes Then
ActiveWindow.View.SplitSpecial = wdPanePrimaryFooter
Selection.Find.Execute Replace:=wdReplaceAll
Application.Run macroname:="NEWMACROS"
ActiveWindow.View.SplitSpecial = wdPanePrimaryHeader
Selection.Find.Execute Replace:=wdReplaceAll
Application.Run macroname:="NEWMACROS"
End If
ActiveDocument.Save
ActiveWindow.Close
Next
Application.ScreenUpdating = True
End With
MsgBox "Operation end, please view", vbInformation
End Sub
Hi there, is there a code for replacing with text that is multiple sentences, with bullet points and quotation marks in MS word using this code - which is fantastic !
hi, i want to replace a number but i guess the problem that it's not working is that the number is not written in english it's in Persian. I would be so thankfull if someone can help me with it.
sorry, i was wrong. the problem is that the number is in the header and it seems that the trick is not working in header. if i open one of the files and activate the header then run the module it works but just in that specific file ,even if i select all the files. thanks again.
Hi, I new to VBA. I am able to get the data updated for only single file. How to select multiple files when the VBA script opens up ? The question might be simple to few, but it will help. Since i need to update a string in 175+ plus word files. Appreciate your quick response. Thanks ...
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
Thanks so much for posting this, absolute lifesaver!
I notice that there is a line "MatchWildcards = False", which implies that it's possible to use wildcards in the search text - is that possible and, if so, what's the protocol?
Hi all, I am new to the whole VBA thing and I Love love love this code! I have 5000+ docs to review and if this works it will save heaps of time! I have the code above running however i can see that it does not cater for replacing text in footers, Only headers and the body of the doc. Can anyone assist in extending this to the entire document. P.S. not sure if this is relevant but the list of words that i need to replace is the same for headers, footers and the body... Any help would really be appreciated!
You can edit the footer by using almost identical code that the header uses. Copy everything from "Begin Header Updates" to "End Header Updates" and paste it directly after.
Then, in this pasted section, find the word "wdSeekCurrentPageHeader" and change it to "wdSeekCurrentPageFooter".
Out of interest what does the line: Application.Run macroname:="NEW MACROS" do? The rest of the code makes sense to me (used to VBA in Excel) but I can't figure out why you need to execute another piece of code here. Thanks for the great tool though.
This macro was amazing..is there any code to update multiple excel files,spss files.also is there is any macro to update the header and footer on multiple word documents .
I am trying to add an entire section to a document that has three lines, bolding, and bullet points. Is there a way to keep that formatting when running the macro?
this was sooo helpful, thank you very much! I have just changed the contents in 90 word files. This is amazing! Just one more tip: at the beginning close all open word documents but one of your file to be change.
You can use a program such as [url]www.officefindreplace.com[/url] to perform the same operation on multiple documents, or multiple operations on the same document. [url]www.officefindreplace.com[/url]
' --- Beging body text replacemnt 3 --- With Selection.Find .Text = "leadership" ' Find What .Replacement.Text = "supervision" ' Replace With .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll ' --- End body text replacemnt 3 ---
Application.Run macroname:="NEWMACROS" ActiveDocument.Save ActiveWindow.Close ' ------------------------------------------------------- ' End of Body Updates ' ------------------------------------------------------- Next
End With Selection.Find.Execute Replace:=wdReplaceAll ' --- Beging header text replacemnt 2 ---
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument ' ------------------------------------------------------ ' End of Header Updates ' ------------------------------------------------------
' ------------------------------------------------------- ' Beginning of Body Updates ' ------------------------------------------------------- Windows(GetStr(j)).Activate Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' Delete additional body replacement blocks if ' not needed or copy/paste additional blocks if ‘ required. ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If ActiveWindow.View.SplitSpecial wdPaneNone Then ActiveWindow.Panes(2).Close End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ ActivePane.View.Type = wdOutlineView Then ActiveWindow.ActivePane.View.Type = wdPrintView End If
I ran across this code while searching with DuckDuckGo. I modified it to suit my needs which were to other requests such as handling multiple search/replace in the header and multiple search/replace in the body. I also modified it handle the older .DOC format and the new .DOCX format. The modified code is pasted below. Feel free to use and improve!
It is being sent in multiple parts because comments to this site can only be 2000 characters or less. ------------------------------------------------------------
This code has saved so much time for me... so, thanks!
One thing though - is there any way to increase the number of words that the macro finds/replaces? I need to find/replace multiple paragraphs at once and the macro seems to have a limit of approximately 200 characters.
Is it possible to tweak this macro to perform multiple 'find and replace' stances at once? There are several words and phareses I need to replace and as of now I need to reinsert the VBA code for every instance.
I am sorry but I have no idea re the headers or the format. It was not something I needed to include in my code. I had never used this before myself and the code I posted was taken from the original code above and then tweeked using code found in other searches until it worked. I am sorry I cant be of more help.
Thanks for posting this! I've run a couple tests and gotten it to work for me; however, it's not working on text in headers and footers for some reason. Is there a fix for this?
It only runs across selected files and files must be in one folder only. This is run as a macro in a word doc. It is run from clicking a button. It only updates word doc's Hope this helps.
Private Sub CommandButton1_Click() Dim MyDialog As FileDialog, GetStr(1 To 100) As String '100 files is the maximum applying this code On Error Resume Next Set MyDialog = Application.FileDialog(msoFileDialogFilePicker) With MyDialog .Filters.Clear '~~> Change this file extention to the relevant doc type. .Filters.Add "All WORD File ", "*.doc", 1 .AllowMultiSelect = True i = 1 If .Show = -1 Then For Each stiSelectedItem In .SelectedItems GetStr(i) = stiSelectedItem i = i + 1 Next i = i - 1 End If Application.ScreenUpdating = False For j = 1 To i Step 1 Set doc = Documents.Open(FileName:=GetStr(j), Visible:=True) Windows(GetStr(j)).Activate Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting
For i = 1 To doc.Hyperlinks.Count 'If the hyperlink matches. If LCase(doc.Hyperlinks(i).Address) = "http://www.yahoo.co.uk/" Then 'Change the links address. doc.Hyperlinks(i).Address = "https://www.google.co.uk" 'Change the links display text if desired. doc.Hyperlinks(i).TextToDisplay = "www.google.co.uk" End If Next Application.Run macroname:="NEWMACROS" ActiveDocument.Save ActiveDocument.Close Next Application.ScreenUpdating = True End With MsgBox "operation end, please view", vbInformation End Sub
You then add one of the following two sections depending on if it is test or hyperlink to be replaced
'~~> This section if uncommented will replace text - ONLY ONE OF TWO SECTIONS CAN BE UNCOMMENTED AT ONCE
With Selection.Find .Text = "www.google.co.uk" 'Find What .Replacement.Text = "www.google.com" 'Replace With .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 Application.Run macroname:="NEWMACROS" ActiveDocument.Save ActiveDocument.Close Next Application.ScreenUpdating = True End With MsgBox "operation end, please view", vbInformation
'~~> This section if uncommented will replace hyperlinks 'For i = 1 To doc.Hyperlinks.Count ' 'If the hyperlink matches. ' If LCase(doc.Hyperlinks(i).Address) = "http://www.google.co.uk/" Then ' 'Change the links address. ' doc.Hyperlinks(i).Address = "https://www.google.com" ' 'Change the links display text if desired. ' doc.Hyperlinks(i).TextToDisplay = "www.google.com" ' End If ' Next 'Application.Run macroname:="NEWMACROS" 'ActiveDocument.Save 'ActiveDocument.Close 'Next 'Application.ScreenUpdating = True 'End With 'MsgBox "operation end, please view", vbInformation
Hi Pia, I am trying to run your script for replacing hyperlinks but am getting errors. Any chance you can post the script for replacing hyperlinks all in 1 piece? I must be messing something up when trying to patch your code together.
This is what finally worked for me. I hope it helps. I added this macro to a word file. It will run the replace any documents selected (you can select as many as you like) when the file dialoge is open. It wont work on sub folders so I did each folder in the file structure individually but it worked.It may not be the best fix but it works at least.
Private Sub CommandButton1_Click() Dim MyDialog As FileDialog, GetStr(1 To 100) As String '100 files is the maximum applying this code On Error Resume Next Set MyDialog = Application.FileDialog(msoFileDialogFilePicker) With MyDialog .Filters.Clear '~~> Change this file extention to the relevant doc type. .Filters.Add "All WORD File ", "*.doc", 1 .AllowMultiSelect = True i = 1 If .Show = -1 Then For Each stiSelectedItem In .SelectedItems GetStr(i) = stiSelectedItem i = i + 1 Next i = i - 1 End If Application.ScreenUpdating = False For j = 1 To i Step 1 Set doc = Documents.Open(FileName:=GetStr(j), Visible:=True) Windows(GetStr(j)).Activate Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting 'Section then either one or the other of sections of code to follow.
I still cannot get this to work on my PC running Windows 7. When I run it, I get an error msg at the line: -Windows(GetStr(j)).Activate The error msg. is: -Compile error: -Sub or Function not defined Any idea why? And how to fix it?
When I run it, it gets hung up and stops at: Application.Run macroname:="NEWMACROS" and when I step into it, it tells me I have a Compile error: Named argument not found. Now what?
przycisk w Typ Pliku sekcja, aby dodać dokumenty Worda, w których znajdziesz i zamieniasz teksty;
