Kapalı word dosyalarındaki kelimelerin değiştirilmesi

[Ali]

Ekli dosya kapalı olan word dokümanlarınızdaki değişmesini istediğiniz kelimeleri word dosyalarınızı açmadan değiştirme imkanını sağlar .
Bunun ne faydası var derseniz diyelimki bir işyerinde görev ve pozisyon değişikliği oldu. Şef, Müdür yada Uzman olan kişi değişti bunun için hala hazırdaki tüm Word dosyalarınızı açıp teker teker kontrol edip elle değiştirmeniz gerekecek.

Ama bu ekli dosya ile yüzlerce word dokümanında isimler yada değişmesini istediğiniz herhangi bir kelimeyi dosyaları teker teker açmadan kullanabilirsiniz.

Freeware bir programın ilgili kısımlarını ben Türkçeleştirdim ve dosya içine özel karekter arama içinde gerekli anlatımları ekledim.

Faydası olması dileğiyle.

 

[Haluk]

Hemen hemen aynı konuda, daha önceden sorulan bir soru üzerine aşağıdaki kodu hazırlamıştım.

Kodun olduğu dokümanın dosya yolundaki tüm dosyaları tarar ve değiştirmeyi yapar ... (Cimbom >> En büyük CİMBOMBOM)

Sub Test()

'// Word dokumanında Find - Replace (Bul - Degistir)  //
'//              Raider® - Haziran 2004               //


    Dim MyPath As String, MyFile As String
    Dim No As Integer, x As Integer, i As Integer
    Dim Msg1 As String, Msg2 As String
    Application.ScreenUpdating = False
    MyPath = ThisDocument.Path
    MyFile = Dir(MyPath & Application.PathSeparator & "*.doc", vbDirectory)
        Do While MyFile <> ""
            If MyFile <> ThisDocument.Name Then
                No = No + 1
                Documents.Open MyPath & Application.PathSeparator & MyFile
                    With Selection.Find
                        .ClearFormatting
                            .Replacement.ClearFormatting
                                   .Text = "CimBom"
                                        .Replacement.Text = "En büyük CİMBOMBOM"
                                    .Forward = True
                                .Wrap = wdFindContinue
                            .MatchCase = False
                            If .Execute Then x = x + 1
                        .Execute Replace:=wdReplaceAll
                     End With
             End If
          MyFile = Dir
        Loop
        For i = Documents.Count To 1 Step -1
            If Documents(i).Name <> ThisDocument.Name Then
              Documents(i).Close SaveChanges:=True
            End If
        Next
    Application.ScreenUpdating = True
    Msg1 = " Kontrol edilen dosya sayısı = " & No
    Msg2 = x & " adet dosyada degistirme yapildi."
    MsgBox Msg1 & vbCrLf & Msg2, vbInformation, "Rapor !"
End Sub

 

[Ali]

Herşey güzelde kodlarda Cimbom olunca değiştirme yapmıyor .Denedim hep En Büyük Beşiktaş diye çalışıyor. Haluk Bey sizde ilgili kodları düzeltirseniz kodların yüzüde gülecektir :mrgreen:

Alternatif kodlarınız için teşekkürler.

 

[Haluk]

:mrgreen:

 

[İsmail Küçükşengün]

sn. Fructose ve sn. Haluk;

Ben de beşiktaşlı olduğum halde, bu sene hem BJK, hem de G.S. lılar, zaten Galatasaray'ın şampiyon olmasını istemediler mi?

 

[Ali]

Forum taşınması ile birlikte silinmiş dosya ektedir.

 

[Ali]

Dosya ilk mesajda güncellenmiştir.