Hücredeki formül sonucuna göre yazı tipi ve boyutunu değiştirme

[demgüzar]

Sorunum şu; ilgilenen herkese şimdiden teşekkürler

Sayfa2 A1 hücresindeki formül sonucu 1 olursa Sayfa1 E7:AH46 hücreleri "Times new roman, 8 punto"

Sayfa2 A1 hücresindeki formül sonucu 2 olursa Sayfa1 E7:AH46 hücreleri "Comic Sans, 5 punto"
olmasını nasıl sağlayabilirim?

Saygılarımla

 

[hamitcan]

Sayfa2'nin kod kısmına ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Sayfa2.[a1] = 1 Then
                       Sayfa1.[e7:ah46].Font.Name = "Times New Roman"
                       Sayfa1.[e7:ah46].Font.Size = 8
ElseIf Sayfa2.[a1] = 2 Then
                       Sayfa1.[e7:ah46].Font.Name = "Comic Sans"
                       Sayfa1.[e7:ah46].Font.Size = 5
Else
                       Sayfa1.[e7:ah46].Font.Name = "Calibri"
                       Sayfa1.[e7:ah46].Font.Size = 11
End If

End Sub

 

[demgüzar]

Sayfa2'nin kod kısmına ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Sayfa2.[a1] = 1 Then
                       Sayfa1.[e7:ah46].Font.Name = "Times New Roman"
                       Sayfa1.[e7:ah46].Font.Size = 8
ElseIf Sayfa2.[a1] = 2 Then
                       Sayfa1.[e7:ah46].Font.Name = "Comic Sans"
                       Sayfa1.[e7:ah46].Font.Size = 5
Else
                       Sayfa1.[e7:ah46].Font.Name = "Calibri"
                       Sayfa1.[e7:ah46].Font.Size = 11
End If

End Sub

Öncelikle ilginize teşekkürler.

Hocam kod çalışıyor ancak bu kodun çalışması için Sayfa1 de herhangi bir hücreye veri girişi yaparmış gibi çift tıklamam gerekiyor. Bu kodun direk olarak sayfa2 a1 hücresindeki formül sonucu değişir değişmez çalışmasının bir yolu yok mu?

Saygılarımla

 

[hamitcan]

Worksheet_Change

yerine

Worksheet_Calculate

olayını kullanın.

 

[demgüzar]

Hocam bir türlü beceremedim.
Dosyayı yolluyorum

"Yazdır" sayfasında yer alan 2. açılır liste (Öğrenci Cevapları ile Öğrenci Cevapları Doğru-Yanlış Durumu" arasına değişiklik yapan denetimin bağlantısı "Hesap" sayfası D1 hücresine bağlı.

Benim istediğim ise şu:

Açılır listeden "Öğrenci Cevapları" seçildiğinde Yazdır sayfasında yer alan E7:AH46 hücrelerinin yazı boyutu 8 punto; açılır listeden "Öğrenci Cevapları Doğru-Yanlış Durumu" seçildiğinde Yazdır sayfasında yer alan E7:AH46 hücrelerinin yazı boyutu 5 punto olsun.

Tekrar saygı ve teşekkürlerimde

 

[hamitcan]

Deneyin.

Private Sub Worksheet_Calculate()
If Sheets("Hesap").[d1] = 1 Then
                       Sheets("Yazdır").[e7:ah46].Font.Name = "Times New Roman"
                       Sheets("Yazdır").[e7:ah46].Font.Size = 8
ElseIf Sheets("Hesap").[d1] = 2 Then
                       Sheets("Yazdır").[e7:ah46].Font.Name = "Comic Sans"
                       Sheets("Yazdır").[e7:ah46].Font.Size = 5
Else
                       Sheets("Yazdır").[e7:ah46].Font.Name = "Calibri"
                       Sheets("Yazdır").[e7:ah46].Font.Size = 11
End If

End Sub

 

[demgüzar]

Hocam elinize sağlık, minnettarım size.

Benim bir de "Değer değiştirme düğmesini kullanarak hücredeki değer kadar yazdırma" başlıklı bir sorum vardı Makro-VBA altında yazdığım. Bir de onunla ilgilenebilirseniz sevinirim. Bakamazsanız da canınız sağolsun. Saygılarımla

http://www.excel.web.tr/f48/deoer-deoi-tirme-duomesini-kullanarak-hucredeki-deoer-kadar-t111240.html

 

[euphrates55]

Sayfa2'nin kod kısmına ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Sayfa2.[a1] = 1 Then
                       Sayfa1.[e7:ah46].Font.Name = "Times New Roman"
                       Sayfa1.[e7:ah46].Font.Size = 8
ElseIf Sayfa2.[a1] = 2 Then
                       Sayfa1.[e7:ah46].Font.Name = "Comic Sans"
                       Sayfa1.[e7:ah46].Font.Size = 5
Else
                       Sayfa1.[e7:ah46].Font.Name = "Calibri"
                       Sayfa1.[e7:ah46].Font.Size = 11
End If

End Sub

ben uyarlamaya çalıştığımda olmadı. neden acaba. e20 hücresine uzunluk formülü yazdım 600 den küçük, 1200 den küçük vs... sonuçlarına göre b15:j16 arası hücrenin yazı ve fontunu ayarlayacak. ama olmuyor. modüle yazdığım kod ise;

Private Sub Worksheet_Change(ByVal Target As Range)
Set s = Sheets("sunu")
If s.[e20] < 600 Then
                       s.[b15:j16].Font.Name = "Times New Roman"
                       s.[b15:j16].Font.Size = 22
ElseIf s.[e20] < 800 Then
                       s.[b15:j16].Font.Name = "Palatino Linotype"
                       s.[b15:j16].Font.Size = 14
                      
Else
                       s.[b15:j16].Font.Name = "Palatino Linotype"
                       s.[b15:j16].Font.Size = 4
End If


End Sub

 

[euphrates55]

Private Sub Worksheet_Calculate()
'UpdatebyExtendoffice20160614
    Dim xCell As Range
    For Each xCell In Range("G2:H9")
        With xCell
            If Len(.Text) > 5 Or Val(.Value) > 10 Then
                .Font.Name = "Arial"
                .Font.Size = 16
            Else
                .Font.Name = "Calibri"
                .Font.Size = 11
            End If
        End With
    Next
End Sub

Extendoffice kaynaklı siteden bu kodu buldum ve çalışıyor ama run sub düğmesine basınca. otomatik olarak çalıştırılabilir mi. yani hücre değeri 5 den fazla olduğunda kendi kendine arial 16 olacak şekilde.

 

[hamitcan]

Change olayını kullanırsanız çalışıyor. G2:H9 arasındaki hücre fontu ve boyutunu ayarlıyor.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xCell As Range
    For Each xCell In Range("G2:H9")
        With xCell
            If Len(.Text) > 5 Or Val(.Value) > 10 Then
                .Font.Name = "Arial"
                .Font.Size = 16
            Else
                .Font.Name = "Calibri"
                .Font.Size = 11
            End If
        End With
    Next

End Sub