Excel'den bir hüceyi word de istediğimiz bir metnin yerine göndermek

[ekremmk]

DENEME WORD.doc adlı bir word dosyam var diyelim içi dolu içinde AHMET diye bir ifade var excelde o word dosyası kapalıyken örneğin sayfa1!a1 hücresine Mehmet yazıp word deki Ahmet ifadesini Mehmet'e çevirebilir miyim? Böyle bir şey yapılabilir mi emin değilim ama excel'de bu da yapılamaz heralde dediğim bir çok şeyin yapılabildiğini gördüm. Bir şansımı deneyeyim dedim . Şimdiden teşekkür ederim.

 

[mancubus]

aşağıdaki kodun üzerinden kendiniz çalışabilirsiniz.

Sub xlTR_197739()

    Dim wdApp As Object, wdDoc As Object
    Dim findTxt As String, replTxt As String
    
    findTxt = "Ahmet"
    replTxt = Worksheets("Sayfa1").Range("A1").Value
    
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False
    Set wdDoc = wdApp.Documents.Open("C:\klasör\altklasör\deneme word.doc")
    
    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findTxt
        .Replacement.Text = replTxt
        .Wrap = 1 'wdFindContinue
        .Execute Replace:=2  'wdReplaceAll
    End With
    
    wdDoc.Save
    wdDoc.Close
    wdApp.Quit

End Sub

 

[nunikmakarios]

DENEME WORD.doc adlı bir word dosyam var diyelim içi dolu içinde AHMET diye bir ifade var excelde o word dosyası kapalıyken örneğin sayfa1!a1 hücresine Mehmet yazıp word deki Ahmet ifadesini Mehmet'e çevirebilir miyim? Böyle bir şey yapılabilir mi emin değilim ama excel'de bu da yapılamaz heralde dediğim bir çok şeyin yapılabildiğini gördüm. Bir şansımı deneyeyim dedim . Şimdiden teşekkür ederim.

neden buna uğraşıyorsunuz ki; worldde bul değiştir seçeneği ile kolayca yaparsınız

 

[ekremmk]

aşağıdaki kodun üzerinden kendiniz çalışabilirsiniz.

Sub xlTR_197739()

    Dim wdApp As Object, wdDoc As Object
    Dim findTxt As String, replTxt As String
   
    findTxt = "Ahmet"
    replTxt = Worksheets("Sayfa1").Range("A1").Value
   
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False
    Set wdDoc = wdApp.Documents.Open("C:\klasör\altklasör\deneme word.doc")
   
    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findTxt
        .Replacement.Text = replTxt
        .Wrap = 1 'wdFindContinue
        .Execute Replace:=2  'wdReplaceAll
    End With
   
    wdDoc.Save
    wdDoc.Close
    wdApp.Quit

End Sub

Hocam emeğiniz için teşekkür ederim. Öncelikle bu kodu module oluşturup oraya kopyaladım dosyayı makro kaydedecek şekle getirdim dosya konumunu ayarladım örnek word dosyasını oluşturdum ama dosya açıkken ve kapalıyken denememe rağmen maalesef çalıştıramadım. Dosya uzantısı docx di uzantıyı doca çevirdim denededim yine olmadı. Hatam nerden kaynaklanıyor acaba?

 

[ekremmk]

neden buna uğraşıyorsunuz ki; worldde bul değiştir seçeneği ile kolayca yaparsınız

Merhaba hocam excelde userform üzerinden bütün işlemlerimi yapıyorum çıktı almam gerekiyor ama excel üzerinde yapınca isimlerden kaynaklı hücre boşlukları oluyor ve gözüme hoş gelmiyor. Bu nedenle userformda textbox a yazdığım verileri doc da değiştirsin ve direkt yazdır butonuna basılsın istiyorum. İlerleyen yerlerini yapabilirim gibi ama word e yazdırma işini çözemedim.

 

[ÖmerFaruk]

@mancubus beyin verdiği kodu denedim çalışıyor.
Aşağıdaki satırlardaki BOLD kısımları kendinize göre uyarlamalısınız

findTxt = "Ahmet"
replTxt = Worksheets("Sayfa1").Range("A1").Value
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False
Set wdDoc = wdApp.Documents.Open("C:\klasör\altklasör\deneme word.doc")

 

[ekremmk]

@mancubus beyin verdiği kodu denedim çalışıyor.
Aşağıdaki satırlardaki BOLD kısımları kendinize göre uyarlamalısınız

findTxt = "Ahmet"
replTxt = Worksheets("Sayfa1").Range("A1").Value
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False
Set wdDoc = wdApp.Documents.Open("C:\klasör\altklasör\deneme word.doc")

Hocam denedim çalıştıramadım kodla alakalı değil ben bişeyleri yanlış yapıyorum sanırım. Modüle içine kodu yapıştırıp bold olan yerleri kendime göre düzenleyip Sayfa1 A1 e yazı yazdığımda word dosyasındaki "Ahmet" yazısının değişmesi lazım ama değişmiyor

 

[ÖmerFaruk]

Sayfa1 A1 e yazı yazdığımda word dosyasındaki "Ahmet" yazısının değişmesi lazım ama değişmiyor.

Kodları module içinde manuel olarak tetikleyince hiç bir işlem yapmıyor mu?
Siz A1 de değişiklik yapınca kodların otomatik çalışmasını mı istiyorsunzu?

 

[ekremmk]

Sayfa1 A1 e yazı yazdığımda word dosyasındaki "Ahmet" yazısının değişmesi lazım ama değişmiyor.

Kodları module içinde manuel olarak tetikleyince hiç bir işlem yapmıyor mu?
Siz A1 de değişiklik yapınca kodların otomatik çalışmasını mı istiyorsunzu?

aynen hocam a1 e veri girişi yaptığımda değişmesini istiyorum. Aslında istediğim butona tıkladığımda aktif olması ama basit isteyim gerisini kendim yapayım diye düşünmüştüm.
Benim normalde istediğim bir buton yapmak ve butona bastığımda değişmiş word dosyasının açılıp yazdır menüsünün gelmesi hatta mümkünse sadece yazdır seçeneğinin gelmesi doc dosyasının hiç görünmemesi
ilginiz için teşekkür ederim.

 

[ÖmerFaruk]

İsteğiniz buysa "a1 e veri girişi yaptığımda değişmesini istiyorum"
Sn @mancubus beyin kodlarını aşağıdaki haliyle kullanabilirsin.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wdApp As Object, wdDoc As Object
    Dim findTxt As String, replTxt As String
    
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    findTxt = "Ahmet"
    replTxt = Target.Value
    
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False
    Set wdDoc = wdApp.Documents.Open("C:\klasör\altklasör\deneme word.doc")
    
    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findTxt
        .Replacement.Text = replTxt
        .Wrap = 1 'wdFindContinue
        .Execute Replace:=2  'wdReplaceAll
    End With
    
    wdDoc.Save
    wdDoc.Close
    wdApp.Quit
End Sub

 

[ekremmk]

aşağıdaki kodun üzerinden kendiniz çalışabilirsiniz.

Sub xlTR_197739()

    Dim wdApp As Object, wdDoc As Object
    Dim findTxt As String, replTxt As String
  
    findTxt = "Ahmet"
    replTxt = Worksheets("Sayfa1").Range("A1").Value
  
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False
    Set wdDoc = wdApp.Documents.Open("C:\klasör\altklasör\deneme word.doc")
  
    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findTxt
        .Replacement.Text = replTxt
        .Wrap = 1 'wdFindContinue
        .Execute Replace:=2  'wdReplaceAll
    End With
  
    wdDoc.Save
    wdDoc.Close
    wdApp.Quit

End Sub

Bu kodu çalıştırabildim. Yazdırma işini de hallettim ama Birden fazla kelimeyi birden fazla değişiklik haline nasıl getirebilirim denedim ama hata aldım.
Ahmeti a1 hücresinde değiştirdiğim hale
Mehmet i de a2 de değiştirdim hale getirmem lazım. Bir de örneğin doc dosyasında Ahmet var ve başka bir yerde Ahmetmehmet geçiyor bu kodu kullaıp Ahmet i değiştirmek istediğimde bitişik olan Ahmetmehmet deki Ahmet de değişiyor onun değişmemesi lazım yani sadece ilgili kelimenin değişmesi lazım. Böyle parça parça oluyor kusura bakmayın ama aynı zamanda öğrenmeye çalışıyorum kendim yapabildiğim şeyleri sormak istemiyorum. Yapamadığımda yazıyorum. İlginiz için tekrar teşekkür ederim.

 

[ÖmerFaruk]

Öncelikle, tam sözcüğü eşleştirip değiştirmeniz için gerekeni ilave edelim. Denemeden yazıyorum kontrol edin lütfen.

    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findTxt
        .Replacement.Text = replTxt
        .Wrap = 1 'wdFindContinue
        .MatchWholeWord = True 'Bu satırı ilave ederseniztam sözcükle eşleştirecektir.
        .Execute Replace:=2  'wdReplaceAll
    End With

Sorunuzun ilk kısmı ise sizin sorunuzun eksik olmasından kaynaklanıyor.

Mesela


WORD içinde değişecek olan sözcükleri bir listede değiştirilecek haliyle B sütununa yazmanız lazım.
Böyle bir durumdan bahsediyorsanız lütfen belirtin.
Farklı bir şey yapmaya çalışıyorsanız lütfen tam olarak açıklayınki cevap vermek isteyenler varsayımlar üzerinden sonuç üretmeden sorunuza hızlı ve doğru şekilde cevap versinler.

 

[ekremmk]

Öncelikle, tam sözcüğü eşleştirip değiştirmeniz için gerekeni ilave edelim. Denemeden yazıyorum kontrol edin lütfen.

    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findTxt
        .Replacement.Text = replTxt
        .Wrap = 1 'wdFindContinue
        .MatchWholeWord = True 'Bu satırı ilave ederseniztam sözcükle eşleştirecektir.
        .Execute Replace:=2  'wdReplaceAll
    End With

Sorunuzun ilk kısmı ise sizin sorunuzun eksik olmasından kaynaklanıyor.

Mesela
Ekli dosyayı görüntüle 231678

WORD içinde değişecek olan sözcükleri bir listede değiştirilecek haliyle B sütununa yazmanız lazım.
Böyle bir durumdan bahsediyorsanız lütfen belirtin.
Farklı bir şey yapmaya çalışıyorsanız lütfen tam olarak açıklayınki cevap vermek isteyenler varsayımlar üzerinden sonuç üretmeden sorunuza hızlı ve doğru şekilde cevap versinler.

O zaman tam olarak istediklerimi yazayım hocam öncesindeki soru karmaşası için özür dilerim

button a basınca
a1 de yazan yerine b1 de yazan gelecek
a2 de yazan yerine b2 de yazan gelecek
bu aşağı doğru türetilebilir olursa çok iyi olur ne kadar değişiklik yapacağım değişken olabiliyor.
ve düzenlenmiş halinin direkt çıktısını verecek

 

[ÖmerFaruk]

Bir önceki mesajımda verdiğim tablo gibi bir tablo üzerinde işlem yapıyorsunuz varsaydım. Yani 1.satır başlık satırı.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wdApp As Object, wdDoc As Object
    Dim findTxt As String, replTxt As String
    
    son = Range("A" & Rows.Count).End(3).Row
    If son < 2 Then son = 2
    
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("A2:B" & son )) Is Nothing Then Exit Sub
    findTxt = Range("A" & Target.Row)
    replTxt = Range("B" & Target.Row)

    If Len(findTxt) < 1 Or Len(replTxt) < 1 Then Exit Sub
    
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False
    Set wdDoc = wdApp.Documents.Open("C:\klasör\altklasör\deneme word.doc")
    
    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findTxt
        .Replacement.Text = replTxt
        .MatchWholeWord = True 'Bu satırı ilave ederseniztam sözcükle eşleştirecektir.
        .Wrap = 1 'wdFindContinue
        .Execute Replace:=2  'wdReplaceAll
    End With
    
    wdDoc.Save
    wdDoc.Close
    wdApp.Quit
End Sub

 

[tahsinanarat]

Sn. @ÖmerFaruk Bey, 14.Mesajınızdaki kodu bir butona atadığımda hata mesajı aldım, Butona atayıp tek seferde değişiklik yapmak için kodda nasıl bir değişiklik yapmalıyız. Teşekkür ederim.

 

[ÖmerFaruk]

Kodu butona atamak derken farklı anlamalar ortaya çıkıyor.

Siz ne yapmak istediğinizi tam olarak tarif edin.
Ona göre cevap verelim.

Sanki exceli yeni öğrenen birine tarif eder gibi.
Şu an bu konuda 16. mesajı yazıyorum ve halen yapmak istediğiniz işlemi ifade edebilmiş değilsiniz.

 

[ekremmk]

Bir önceki mesajımda verdiğim tablo gibi bir tablo üzerinde işlem yapıyorsunuz varsaydım. Yani 1.satır başlık satırı.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wdApp As Object, wdDoc As Object
    Dim findTxt As String, replTxt As String
  
    son = Range("A" & Rows.Count).End(3).Row
    If son < 2 Then son = 2
  
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("A2:B" & son )) Is Nothing Then Exit Sub
    findTxt = Range("A" & Target.Row)
    replTxt = Range("B" & Target.Row)

    If Len(findTxt) < 1 Or Len(replTxt) < 1 Then Exit Sub
  
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False
    Set wdDoc = wdApp.Documents.Open("C:\klasör\altklasör\deneme word.doc")
  
    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = findTxt
        .Replacement.Text = replTxt
        .MatchWholeWord = True 'Bu satırı ilave ederseniztam sözcükle eşleştirecektir.
        .Wrap = 1 'wdFindContinue
        .Execute Replace:=2  'wdReplaceAll
    End With
  
    wdDoc.Save
    wdDoc.Close
    wdApp.Quit
End Sub

Kodu butona atamak derken farklı anlamalar ortaya çıkıyor.

Siz ne yapmak istediğinizi tam olarak tarif edin.
Ona göre cevap verelim.

Sanki exceli yeni öğrenen birine tarif eder gibi.
Şu an bu konuda 16. mesajı yazıyorum ve halen yapmak istediğiniz işlemi ifade edebilmiş değilsiniz.

15. mesajı yazan kişi farklı hocam.

 

[ÖmerFaruk]

Özür dilerim. Hakkını helal et.

 

[ekremmk]

Özür dilerim. Hakkını helal et.

Estağfirullah hocam