Word de istenilen kelimeleri renklendirme?

[hernann]

300 sayfaya varan word sayfasında istediğimiz kelimeleri nasıl renklendire biliriz... bunu kodla ve farklı şekilde nasıl yapabiliriz..

ayrıca bunu yapabilirsek aradığımız kelimelerin geçtiği sayfaları kodla farklı bir sayfaya aktarabilirmiyiz...

umarım bir çözüm yolu bulan olur... şimdiden teşekkür ederim herkese...

 

[leumruk]

Merhaba,
1. isteğinizi CTRL H ile değiştir menüsünü açın. Aranan kısmına ANKARA, değiştir kısmına ANKARA yazın. Ardından tüm seçenekler butonuna tıklayın. İmleç "Yeni Değer" kutucuğunda iken "Biçim" menüsüsünden "Yazı Tipi" seçeneğine girin, istediğiniz rengi seçtikten sonra "Tümünü Değiştir" butonuna tıklayın.

2. isteğiniz için makro yazmak gerekir. Makro yazmak için de üzerinde deneme yapabilmek için sayfa sayısının isteğinize uygun miktarda olduğu bir örnek eklemelisiniz. Ayrıca ayrı bir sayfaya aktarmakla kastettiğiniz her birinin ayrı bir word dosyası olarak kaydedilmesi mi; yoksa bu sayfaların tek bir word dosyasında birleştirilmesi mi?

 

[hernann]

cevabınız için çok teşekkür ederim...
ben aynı anda 5-6 kelime aramak istiyorum...yani 300 sayfanın içerisinde o 5-6 kelimeyi bulup renklendirmesini istiyorum...bu kelime ve kriterler hergün değişebilir..ama 350-400 sayfa hep var...

ayrıca "yoksa bu sayfaların tek bir word dosyasında birleştirilmesi mi?" sorusun cevabı evet...biz bunu istiyoruz abicim.. o renkli olan kısımların sayfaların hepsini tek bir word dosyasında toplamak...

 

[leumruk]

Merhaba,
İşlem sonunda "yeni" isimli bir word dosyası oluşacaktır. Bu makro her çalıştırıldığında oluşacağından eski kayıt silinecektir. Bu nedenle yeni isimli dosyayı belirleyeceğiniz bir yere farklı isimle kaydedin. Ana dosyanız silinmeyecek ilk haliyle işlem sonunda kapanacaktır.

Sub calistir()
Application.ScreenUpdating = False
aranan = Array("", "MUĞLA", "BİTLİS", "VAN")
For q = 1 To UBound(aranan)
ara = aranan(q)
    With Selection.Find
    .ClearFormatting
    .Font.Color = wdColorAutomatic
    .Replacement.ClearFormatting
    .Replacement.Font.Color = 192
        .Text = ara
        .Replacement.Text = ara
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .Execute Replace:=wdReplaceAll
    End With
    
Next

For x = ActiveDocument.ComputeStatistics(2) To 1 Step -1
Say = 0
Selection.GoTo What:=1, Which:=2, Name:=x
For y = 1 To UBound(aranan)
If InStr(1, Selection.Bookmarks("\page").Range, aranan(y)) > 0 Then
Say = Say + 1
End If
Next
If Say = 0 Then Selection.Bookmarks("\page").Range.Delete
Next

ActiveDocument.SaveAs ThisDocument.Path & "\yeni.doc"
MsgBox "İşlem tamamlandı.", vbInformation, "l e u m r u k"
End Sub

 

[hernann]

leumruk , ALLAH razı olsun.. şu cuma vakti..gerçekten çok teşekkür ederim..çok sağolun..devlete millete büyük bi hizmet yaptınız..farklı bi yerde kullanacağız..çok sağolun..teşekkür ederim..çok sağolun...

 

[leumruk]

leumruk , ALLAH razı olsun.. şu cuma vakti..gerçekten çok teşekkür ederim..çok sağolun..devlete millete büyük bi hizmet yaptınız..farklı bi yerde kullanacağız..çok sağolun..teşekkür ederim..çok sağolun...

Rica ederim. İşinize yaradığına sevindim.