Excel'den Word'de kelime değiştirme

[hamitcan]

Arkadaşlar merhaba,
Excel yardımıyla Word'de kelime değiştirmek istiyorum. Aşağıdaki kodu kullanıyorum fakat değiştirmiyor. Nerede hata yapıyorum anlamadım. Yardımlarınız için teşekkürler...

Sub test1()

Dim pathh As String
Dim pathhi As String
Dim oCell  As Integer
Dim from_text As String, to_text As String
Dim WA As Object

pathh = "C:\testx.docx"

Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True

'For oCell = 1 To 100
'from_text = Sheet1.Range("A" + CStr(oCell)).Value
'to_text = Sheet1.Range("B" + CStr(oCell)).Value
from_text = [a1]
to_text = [b1]


WA.Activate
    WA.Selection.Find.ClearFormatting
    WA.Selection.Find.Replacement.ClearFormatting




With WA
With .Selection.Find
.ClearFormatting
.Replacement.ClearFormatting

.Text = from_text
.Replacement.Text = to_text
.Execute Replace:=wdReplaceAll
End With
End With
Next
WA.Save
End Sub

 

[halit3]

Böyle denermisiniz.

Sub test1()

Dim pathh As String
Dim pathhi As String
Dim oCell  As Integer
Dim from_text As String, to_text As String
Dim WA As Object
pathh = "C:\testx.docx"

from_text = [a1]
to_text = [b1]
Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True
WA.Activate
WA.Selection.Find.ClearFormatting
WA.Selection.Find.Replacement.ClearFormatting
With WA
With .Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = from_text
.Replacement.Text = to_text
.Execute Replace:=wdReplaceAll
End With
End With
End Sub

referanslarda word seçilmeli

 

[halit3]

referanslarda word seçilmeli

veya

Sub tablo_word1()

Dim objWord As Word.Application
Dim docWord As Word.Document
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
yol = "C:\testx.docx"

Set docWord = objWord.Documents.Open(Filename:=yol, ReadOnly:=True)
Set myRange = objWord.ActiveDocument.Content
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = [a1]
.Replacement.Text = [b1]
.Execute Replace:=wdReplaceAll
End With
objWord.Selection.Find.Execute
docWord.Close False
objWord.Quit
Set docWord = Nothing
MsgBox "işlem tamam"

End Sub

 

[Haluk]

Hamit Bey, aşağıdaki Excel VBA kodunu kullanabilirsiniz...

Not: Word dosyasının dosya yolunu kendinize göre değiştirmeniz gerekir....

Sub Test2()
'   Haluk - 03/10/2021
'   sa4truss@gmail.com
'   https://excelhaluk.blogspot.com/

    Dim filePath As String
    Dim from_text As String, to_text As String
    Dim objWord As Object, regExp As Object
   
    filePath = "C:\TestFolder\testx.docx"
   
    Set objWord = CreateObject("Word.Application")
    Set myDoc = objWord.Documents.Open(filePath)
   
    from_text = [a1]
    to_text = [b1]
   
    Set regExp = CreateObject("VBscript.RegExp")
   
    regExp.Pattern = from_text
    regExp.Global = True
   
    myDoc.Range.Text = regExp.Replace(myDoc.Range.Text, to_text)
   
    Set regExp = Nothing
    myDoc.Save
    myDoc.Close
    objWord.Quit
    Set myDoc = Nothing
   
    MsgBox "İşlem tamam..."
End Sub

.

 

[hamitcan]

Halit Bey ve Haluk Bey, ellerinize sağlık kodlar çok iyi çalışıyor. Yalnız Halit Bey 3 nolu mesajdaki kodu çalıştıramadım. Üzerinde tekrar çalışıyorum. Devamında, toplu word dosyalarını değiştireceğim. Bittiğinde aynı başlıkta paylaşırım.

 

[halit3]

3 nolu mesajdaki kod çalışıyor ancak kayıt etmeden dosya kapanıyor kayıt et makrosuda eklenmeli

docWord.Save

 

[hamitcan]

Word'te toplu kelime değiştirme ile ilgili kodu paylaşıyorum. Faydalı olması dileğiyle...

Sub TopluDosyaDegistirme()
    Dim pathh As String
    Dim from_text As String, to_text As String
    Dim WA As Object
    Dim MyFSO As FileSystemObject
    Dim MyFile As File
    Dim MyFolder As Folder
    Set MyFSO = New Scripting.FileSystemObject
    pathh = ThisWorkbook.Path
    
    Set MyFolder = MyFSO.GetFolder(pathh)
    For Each MyFile In MyFolder.Files
        If MyFile.Name = ActiveWorkbook.Name Or MyFile.Name = "~$Wordde Kelime Degistir.xlsm" Then GoTo 10
        Set WA = CreateObject("Word.Application")
        WA.Documents.Open (pathh & "\" & MyFile.Name)
        WA.Visible = False 'True
        WA.Activate
        WA.Selection.Find.ClearFormatting
        WA.Selection.Find.Replacement.ClearFormatting
    For i = 2 To 3
        from_text = Cells(i, 1): to_text = Cells(i, 2)
    With WA
    With .Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = Trim(from_text)
        .Replacement.Text = to_text
        .MatchWholeWord = True
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With
    End With
        WA.Documents.Save NoPrompt:=True, _
        OriginalFormat:=wdOriginalDocumentFormat
    Next
    WA.Quit
10
    Next MyFile
End Sub