Hücre içinde renkli harfler...

Katılım
15 Ocak 2008
Mesajlar
530
Excel Vers. ve Dili
office 2013 Ingilizce
Herkesin Rmazan bayramı mübarek olsun...şunu yapabilmek mümkünmüdür?
a1 hücresine "STF" yazdım her harfin başka renkte olması bir macro ile sağlanabilirmi?
 
Katılım
27 Temmuz 2004
Mesajlar
719
Excel Vers. ve Dili
Excel 2003 Tr
İki kod grubunu da deneyebilirsiniz.
Kod:
    For i = 1 To Len(ActiveCell.Text)
    ActiveCell.Characters(Start:=i, Length:=1).Font.ColorIndex = i
    Next

    For i = 1 To Len(ActiveCell.Text)
    ActiveCell.Characters(Start:=i, Length:=1).Font.ColorIndex = Int(Rnd() * 57)
    Next
 
Katılım
15 Ocak 2008
Mesajlar
530
Excel Vers. ve Dili
office 2013 Ingilizce
ilginiz için teşekkür ederim denedim olmadı bu kodu direkt sheet in kod bölümüne mi yapıştırıcam açıklamanız mümkünmü?
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,454
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayınız.

A sütünundaki ilgili hücrenin değişmesi ile çalışacaktır.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
For i = 1 To Len(Target)
Target.Characters(Start:=i, Length:=1).Font.ColorIndex = Int(56 * Rnd + 1)
Target.Characters(Start:=i, Length:=1).Font.Size = i + 9
Next
Son:
End Sub
 

Ekli dosyalar

Katılım
15 Ocak 2008
Mesajlar
530
Excel Vers. ve Dili
office 2013 Ingilizce
hocam ellerinize sağlık fakat şöye bi sorunum var ben aynı zamanda a1 hücresını sürekli aktif yapan bir macro kullanıyorum dolayısı ile entre basınca aktif hücre yine a1 olduğundan renkler değişmiyor zannedersem

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address = "$A$1" And Target <> "" Then [$A$1].Select
End Sub
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,454
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Aşağıdaki kodları dener misiniz? Yine ilgili sayfanın kod bölümünde olmalı her ikisi de



Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Target.Offset(0, 0).Select
End Sub
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
For i = 1 To Len(Target)
Target.Characters(Start:=i, Length:=1).Font.ColorIndex = Int(56 * Rnd + 1)
Target.Characters(Start:=i, Length:=1).Font.Size = i + 9
Next
Target.Offset(0, 0).Select
Son:
End Sub
 
Üst