• DİKKAT

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

koşullu yazı karakteri değiştime

  • Konbuyu başlatan Konbuyu başlatan Jeeday
  • Başlangıç tarihi Başlangıç tarihi
Katılım
7 Mayıs 2006
Mesajlar
367
Excel Vers. ve Dili
2019 İngilizce
sorum şu:

bir hücredeki değer eğer "ahmet" ise yazı karakteri Tahoma 17 ve bold olsun, eğer "mehmet" ise arial 20 ve italik olsun

olabilirliği var mı acaba?
 
onu biliyorum fakat koşullu biçimlendirmede Font bölümünde yazı karakteri seçme bölgesi hep aktif durumda değil... sadece yazı karakteri rengini seçebiliyorum....
 
Çalşma sayfasının kod bölümüne;

Kod:
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
 
Target.ClearFormats
 
With Target.Font
    If Target = "ahmet" Then
        .Name = "Tahoma"
        .Size = 17
        .Bold = True
    ElseIf Target = "mehmet" Then
        .Name = "Arial"
        .Size = 20
        .Italic = True
    End If
End With
        
End Sub
.
 
Bunu nasıl a sütununa yayarız ve 5-6 tane değişik kelime için yaparız?
 
Yeni şartlarınız nedir.
 
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [R:R]) Is Nothing Then Exit Sub

Target.ClearFormats

With Target.Font
If Target = "Jean Pierre" Then
.Name = "Jean Pierre"
.Size = 15
.Bold = False
ElseIf Target = "Cousin's" Then
.Name = "Dragon"
.Size = 15
.Bold = False
ElseIf Target = "Jean Paul" Then
.Name = "Tiffany Lt BT"
.Size = 14
.Bold = True
ElseIf Target = "Novyo" Then
.Name = "Times New Roman"
.Size = 15
.Bold = True
End If
End With

End Sub


run time error "28"
out of stack space

debug'a basınca
If Intersect(Target, [R:R]) Is Nothing Then
sarı ile boyanmış gözüküyor...
 
.Name = "Jean Pierre"
.Name = "Dragon"
.Name = "Tiffany Lt BT"
.Name = "Times New Roman"

Kırmızı işaretli verilerin adın da yazı tipi varmı bilmiyorum. Ben kodlara olan yazı tiplerinden örnek olarak yazdım. Siz kendinize göre değiştirirsiniz.

Aşağıdaki kodları deneyiniz.

Kod:
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Intersect(Target, [R:R]) Is Nothing Then Exit Sub
 
On Error GoTo sil
Target.ClearFormats
 
With Target.Font
    If Target = "Jean Pierre" Then
        .Name = "[COLOR=blue]Arial[/COLOR]"
        .Size = 15
        .Bold = False
    ElseIf Target = "Cousin's" Then
        .Name = "[COLOR=blue]Cambria[/COLOR]"
        .Size = 15
        .Bold = False
    ElseIf Target = "Jean Paul" Then
        .Name = "[COLOR=blue]Comic Sans MS[/COLOR]"
        .Size = 14
        .Bold = True
    ElseIf Target = "Novyo" Then
        .Name = "[COLOR=blue]Times New Roman[/COLOR]"
        .Size = 15
        .Bold = True
    End If
End With
 
Exit Sub
sil:
Application.EnableEvents = False
    Selection.Clear
Application.EnableEvents = True
 
End Sub

.
 
2003 de denedim sorunsuz çalıştı. 2007 bende kurulu değil.

.
 
peki boş bi sayfaya kaydedip bana yollar mısın? convert ederim ben
 
Dosya ektedir..

.
 

Ekli dosyalar

valla yolladığın dosyayı denedim..aynı hatayı veriyor...
 
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [R:R]) Is Nothing Then Exit Sub

Target.ClearFormats

With Target.Font
If Target = "Jean Pierre" Then
.Name = "Jean Pierre"
.Size = 15
.Bold = False
ElseIf Target = "Cousin's" Then
.Name = "Dragon"
.Size = 15
.Bold = False
ElseIf Target = "Jean Paul" Then
.Name = "Tiffany Lt BT"
.Size = 14
.Bold = True
ElseIf Target = "Novyo" Then
.Name = "Times New Roman"
.Size = 15
.Bold = True
End If
End With

End Sub


run time error "28"
out of stack space

debug'a basınca
If Intersect(Target, [R:R]) Is Nothing Then
sarı ile boyanmış gözüküyor...
bu bir deneme
 
Geri
Üst