Arama ve birçok Word (.doc) dosyasında (işlemin otomasyonu amacıyla) değiştirmek için bir yol arıyorum.
Şimdiye kadar bulduğum yazılım sadece aramama izin veriyor, ancak değiştirmeme izin vermiyor.
Bunu Word ile nasıl yapabilirim?
Arama ve birçok Word (.doc) dosyasında (işlemin otomasyonu amacıyla) değiştirmek için bir yol arıyorum.
Şimdiye kadar bulduğum yazılım sadece aramama izin veriyor, ancak değiştirmeme izin vermiyor.
Bunu Word ile nasıl yapabilirim?
Yanıtlar:
VBA Bul ve Değiştir'i (önbellek bağlantısı) deneyebilirsiniz .
VBA Bul ve Değiştir ©, tek kullanıcı tanımlı "bul" ve "değiştir" değişken çiftlerini ya da kullanıcı tanımlı "bul" ve "değiştir" listesini kullanarak belgenin herhangi bir yerinde (veya belge koleksiyonunda) metin bulmak ve değiştirmek için bir yöntem sağlar çiftleri. Ayrıca, metni bulmak ve bulunan metni kullanıcı tanımlı "Otomatik Metin" veya "Yapı Taşı" girişiyle değiştirmek için bir yöntem de sağlar.
Verilen kök klasör altındaki birden çok klasörde bulunan birden çok MS Word dosyasında birden çok normal ve joker karakter tabanlı değiştirme gerçekleştirmek için, VBA makrosunu izledim. Kullanmak için, aşağıdaki değişkenlerin (sabitler) içeriğini değiştirebilirsiniz:
Belki yararlı bulabilirsiniz :-)
Sub GlobalTextReplacement()
' Root under which all manuals are stored
Dim rootPath As String
rootPath = "c:\Data\Manuals\"
' Find and replace text for wildcard replacement. Performed first.
Dim findTextsWild() As Variant, replaceTextsWild() As Variant
findTextsWild = Array("[ ]{2;}", "[cC]onfiguration[/ ]@[pP]olicy [rR]epository", "[sS]ervlet[- ]@[fF]ilter")
replaceTextsWild = Array(" ", "Configuration/Policy Repository", "Servlet-Filter")
' Find and replace text for normal case insensitive replacement. Performed second.
Dim findTexts() As Variant, replaceTexts() As Variant
findTexts = Array("DirX Access", "Policy Repository", "User Repository", "Servlet", "servletfilter", "SAML assertion", "DirX Access Server", "DirX Access Manager", "Deployment Manager", "Policy Manager", "Client SDK", "^p ", " ^p")
replaceTexts = Array("DirX Access", "Policy Repository", "User Repository", "Servlet", "Servlet-Filter", "SAML assertion", "DirX Access Server", "DirX Access Manager", "Deployment Manager", "Policy Manager", "Client SDK", "^p", "^p")
' Main code
Application.ScreenUpdating = False
Dim dirNames(20) As String
Dim dirNamesCount As Integer
dirNamesCount = 0
Dim dirName As String
dirName = Dir$(rootPath & "*", vbDirectory)
Do Until LenB(dirName) = 0
Dim dirPath As String
dirPath = rootPath & dirName
If ((GetAttr(dirPath) And vbDirectory) = vbDirectory) And (dirName <> ".") And (dirName <> "..") Then
dirNamesCount = dirNamesCount + 1
dirNames(dirNamesCount) = dirPath & "\"
End If
dirName = Dir$
Loop
Do While dirNamesCount > 0
Dim fileName As String
dirName = dirNames(dirNamesCount)
dirNamesCount = dirNamesCount - 1
fileName = Dir$(dirName & "*.doc", vbDirectory)
Do Until LenB(fileName) = 0
Dim filePath As String
filePath = dirName & fileName
fileName = Dir$
Dim document As document
Set document = Documents.Open(filePath)
document.TrackRevisions = True
document.Select
Dim i As Integer, maxIndex As Integer
maxIndex = UBound(findTextsWild)
For i = LBound(findTextsWild) To maxIndex
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = findTextsWild(i)
.Replacement.Text = replaceTextsWild(i)
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue, MatchWildcards:=True
End With
Next
maxIndex = UBound(findTexts)
For i = LBound(findTexts) To maxIndex
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = findTexts(i)
.Replacement.Text = replaceTexts(i)
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue, MatchCase:=False, MatchWildcards:=False
End With
Next
document.Save
document.Close
Loop
Loop
Application.ScreenUpdating = True
End Sub
Microsoft Word'ün kendisinde yapılamaz mı?
Düzen menünüzde (Word 2003) veya Giriş sekmesinde / Düzenleme bölümünde (Word 2007)
Microsoft Word'ünüz yoksa ve size yardımcı olacak ücretsiz bir alternatif arıyorsanız, OpenOffice.org'u deneyin .
Bu işlemi otomatikleştirmenin bir yolunu arıyorsanız, bunun size yardımcı olacağını düşünmüyorum.
Notepad ++ "Dosyalarda Bul" seçeneğini kullanarak bunu yapabilir
Option Explicit
Public Sub BatchReplaceAll()
Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
PathToUse = ActiveDocument.Path
On Error Resume Next
Documents.Close SaveChanges:=wdPromptToSaveChanges
FirstLoop = True
myFile = Dir$(PathToUse & "\*.doc*")
While myFile <> ""
Set myDoc = Documents.Open(PathToUse & "\" & myFile)
If FirstLoop Then
Application.Dialogs(wdDialogEditReplace).Show
FirstLoop = False
Response = MsgBox("Do you want to process the rest of the files in this folder", vbYesNo)
If Response = vbNo Then Exit Sub
Else
With Dialogs(wdDialogEditReplace)
.ReplaceAll = 1
.Execute
End With
End If
myDoc.Close SaveChanges:=wdSaveChanges
myFile = Dir$()
Wend
End Sub