• DİKKAT

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

Word' de ":" Kadar Kırmızı Yapma

Seyit Tiken

Seyit Tiken

Uzman
Uzman
Katılım
23 Ağustos 2005
Mesajlar
4,652
Excel Vers. ve Dili
Excel : 2010
S.A,
Arkadaşlar, karakter sayısı(kelimenin karakter sayısı) değişen bir çalışma yapıyorum, ":" 'ye kadar kısmını kırmızı yapmak istiyorum, örnek olarak ; yazının başında olan Test : kısmını kodla kırmızı yapmak istiyorum, teşekkür ediyorum, Allah razı olsun.
 
Son düzenleme:
Sayfa kodu olarak kopyalayınız.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Long
say = Len(Target) - Len(WorksheetFunction.Substitute(Target, ":", ""))
If say > 0 Then
     Bul = WorksheetFunction.Find(":", Target.Text)
Target.Characters(Start:=1, Length:=Bul).Font.ColorIndex = 3
End If
End Sub
 
Son düzenleme:
Sayın ÇITIR çok teşekkür ediyorum, Excel için değil, Word içindir.
 
Sayın Seyit Tiken;
Özür dilerim.Ben excel deki yazı için anladım.Word için nasıl olur bilmiyorum.Bilen bir arkadaş en kısa zamanda yazaçaktır umarım.
 
Bu konuya Sayın leumruk üstat el atacaktır.
 
Sayın leumruk konuyla ilgilenene kadar, şimdilik aşağıdaki Word VBA kodlarını deneyebilirsiniz.

Bu kod, 1. mesajda verilen resimdeki örnekte belirtildiği gibi; Word dokümanının başından başlayarak, bulduğu ilk ":" karakterine kadar olan metnin rengini kırmızı yapar.

Kod: 
Sub Test()
    Set myRange = ActiveDocument.Content
    myRange.Find.Execute FindText:=":"
    If myRange.Find.Found = True Then
        ActiveDocument.Range(Start:=0, End:=myRange.Start).Font.ColorIndex = wdRed
    End If
End Sub


Aşağıdaki kod ise; Word dokümanında sizin fareyle seçim yaptığınız alanın başından (ya da imlecin bulunduğu yerden) başlayarak, bulduğu ilk ":" karakterine kadar olan metnin rengini kırmızı yapar.

Kod: 
Sub Test2()
    Set myRange = Selection
    xStart = Selection.Start
    myRange.Find.Execute FindText:=":"
    If myRange.Find.Found = True Then
        yEnd = myRange.Start
        ActiveDocument.Range(Start:=xStart, End:=yEnd).Font.ColorIndex = wdRed
    End If
End Sub


.
 
Son düzenleme:
Haluk abe teşekkür ediyorum, ufak bir şey kaldı, ":"(iki nokta üst üste)'yi de kırmızı yaparsa tamam olur.

Word'ün kod prof'u sayın leumruk'tur.

Not : Sayın leumruk'un Excel 'Metin Kutusu' için yazmış olduğu kod aşağıdadır,
Kurcaladım Word'de uyarlayamadım. Bir fikir verebilir.

Kod: 
With ActiveSheet.Shapes("TextBox 8").TextFrame2.TextRange
For x = 1 To .Characters.Count
If .Characters(x).Text = ":" Then
.Characters(1, x).Font.Fill.ForeColor.RGB = RGB(192, 0, 0)
Exit Sub
End If
Next
End With
 
Önerdiğim 1. kod için aşağıda kırmızı renkle belirttiğim ilaveyi yapın;

Rich (BB code): 
ActiveDocument.Range(Start:=0, End:=myRange.Start + 1).Font.ColorIndex = wdRed


2. kod için de aşağıdakini;

Rich (BB code): 
ActiveDocument.Range(Start:=xStart, End:=yEnd + 1).Font.ColorIndex = wdRed

.
 
Son düzenleme:
Haluk abe işlem tamam, çook teşekkür ediyorum, Allah razı olsun...
 
Kolay gelsin...

.
 
Daha önce benzer bir çalışma yapmıştım. Alternatif olsun
Kod: 
Sub Makro2()
For i = 1 To ActiveDocument.Words.Count
If ActiveDocument.Words(i) = ": " Then
 ActiveDocument.Words(i).Font.ColorIndex = wdRed
 ActiveDocument.Words(i - 1).Font.ColorIndex = wdRed
End If
Next
End Sub
 
Haluk Bey tevazu göstermiş. Kendisi de kodlara takla attıran olarak tanınır hem Türkiye forumlarında hem yabancı forumlarda.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst