World'de bir klasör içindeki cümleyi komple değiştirme

Katılım
16 Şubat 2006
Mesajlar
201
Excel Vers. ve Dili
Excel 2007
Altın Üyelik Bitiş Tarihi
14.03.2019
Bir klasör içersinde 150-200 tane world dosyalarımız var. Hepsinde de 4-5 kelimeden oluşan bir kalıp cümle var. şöyleki " ARAÇ BAKIM ONARIM DAİRESİ "

Bu daire kapandı ve ismi " ARAÇ YENİLEME BAŞKANLIĞI" oldu. şimdi bu klasör içersindeki tüm başlıkları bu yeni şekli ile otomatik olarak dosyaları tek tek açmadan yapabileceğim bir makro v.s. varmıdır ?
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Yeni bir MS Word belgesi açın ve aşağıdaki kodu bu yeni belgeye yerleştirdikten sonra, bahsettiğiniz diğer dokümanların olduğu klasöre yerleştirin.

Daha sonra Test isimli makroyu çalıştırın.

Kod:
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 = "ARA&#199; BAKIM ONARIM DA&#304;RES&#304;"
                                        .Replacement.Text = "ARA&#199; YEN&#304;LEME BA&#350;KANLI&#286;I"
                                    .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&#305;s&#305; = " & No
    Msg2 = x & " adet dosyada degistirme yapildi."
    MsgBox Msg1 & vbCrLf & Msg2, vbInformation, "Rapor !"
End Sub
.
 
Katılım
16 Şubat 2006
Mesajlar
201
Excel Vers. ve Dili
Excel 2007
Altın Üyelik Bitiş Tarihi
14.03.2019
Teşekkürler, emek vermişsiniz. Fakat Hata veriyor, veya ben beceremedim. İlgili dosyayı burayasiz ekyelebilirseniz çok memnun olurum. Teşekkürler tekrar.
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Dosya ektedir ...


.
 
Katılım
16 Şubat 2006
Mesajlar
201
Excel Vers. ve Dili
Excel 2007
Altın Üyelik Bitiş Tarihi
14.03.2019
Teşekkürler Emeğinize, Ellerinize sağlık.
 
Üst