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

Seyit Tiken · 15 Temmuz 2018

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.

çıtır · 15 Temmuz 2018

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

Seyit Tiken · 15 Temmuz 2018

Sayın ÇITIR çok teşekkür ediyorum, Excel için değil, Word içindir.

çıtır · 15 Temmuz 2018

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.

assenucler · 15 Temmuz 2018

Bu konuya Sayın leumruk üstat el atacaktır.

Haluk · 15 Temmuz 2018

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

.

Seyit Tiken · 15 Temmuz 2018

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

Haluk · 15 Temmuz 2018

Ö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

.

Seyit Tiken · 15 Temmuz 2018

Haluk abe işlem tamam, çook teşekkür ediyorum, Allah razı olsun...

Haluk · 15 Temmuz 2018

Kolay gelsin...

.

alicimri · 18 Temmuz 2018

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

Seyit Tiken · 19 Temmuz 2018

Ali bey teşekkürler, Allah razı olsun.

Ali · 19 Temmuz 2018

Haluk Bey tevazu göstermiş. Kendisi de kodlara takla attıran olarak tanınır hem Türkiye forumlarında hem yabancı forumlarda.

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

Seyit Tiken

Uzman

çıtır

Seyit Tiken

Uzman

çıtır

assenucler

Haluk

𐱅𐰇𐰼𐰚

Seyit Tiken

Uzman

Haluk

𐱅𐰇𐰼𐰚

Seyit Tiken

Uzman

Haluk

𐱅𐰇𐰼𐰚

alicimri

Seyit Tiken

Uzman

Ali

Uzman