• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

E

ekremmk

Katılım
21 Kasım 2018
Mesajlar
153
Excel Vers. ve Dili
Excel 2013 , Türkçe
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.
 
aşağıdaki kodun üzerinden kendiniz çalışabilirsiniz.

Ruby: 
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
 
ekremmk' Alıntı:
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.
Genişletmek için tıkla ...
neden buna uğraşıyorsunuz ki; worldde bul değiştir seçeneği ile kolayca yaparsınız
 
mancubus' Alıntı:
aşağıdaki kodun üzerinden kendiniz çalışabilirsiniz.

Ruby: 
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
Genişletmek için tıkla ...
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?
 
nunikmakarios' Alıntı:
neden buna uğraşıyorsunuz ki; worldde bul değiştir seçeneği ile kolayca yaparsınız
Genişletmek için tıkla ...
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.
 
@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")
 
ÖmerFaruk' Alıntı:
@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")
Genişletmek için tıkla ...
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
 
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?
 
ÖmerFaruk' Alıntı:
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?
Genişletmek için tıkla ...
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.
 
İsteğiniz buysa "a1 e veri girişi yaptığımda değişmesini istiyorum"
Sn @mancubus beyin kodlarını aşağıdaki haliyle kullanabilirsin.
C++: 
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
 
mancubus' Alıntı:
aşağıdaki kodun üzerinden kendiniz çalışabilirsiniz.

Ruby: 
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
Genişletmek için tıkla ...
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.
 
Öncelikle, tam sözcüğü eşleştirip değiştirmeniz için gerekeni ilave edelim. Denemeden yazıyorum kontrol edin lütfen.
C++: 
    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
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.
 
ÖmerFaruk' Alıntı:
Öncelikle, tam sözcüğü eşleştirip değiştirmeniz için gerekeni ilave edelim. Denemeden yazıyorum kontrol edin lütfen.
C++: 
    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.
Genişletmek için tıkla ...
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
 
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ı.

C++: 
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
 
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.
 
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.
 
ÖmerFaruk' Alıntı:
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ı.

C++: 
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
Genişletmek için tıkla ...
ÖmerFaruk' Alıntı:
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.
Genişletmek için tıkla ...
15. mesajı yazan kişi farklı hocam.
 
Özür dilerim. Hakkını helal et.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst