Soru Sadece herhangi bir tarih girildiğinde kodun çalışması

Katılım
14 Kasım 2021
Mesajlar
42
Excel Vers. ve Dili
Excell 2010 Türkçe
Merhaba aşağıdaki koda ne eklemem gerekiyor belirli aralıktaki hücrelerde sadece tarih girilmişse renklendirsin . Koşullu biçimlendirmede yapıyorum fakat arada bir kayboluyor. Sürekli Yeniden biçimlendirmem gerekiyor.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)



Range("C3:N85").Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "İtalik"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = 45
.Gradient.ColorStops.Clear
End With
With Selection.Interior.Gradient.ColorStops.Add(0)
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.Color = 3145519
.TintAndShade = 0
End With
End Sub
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Deneyiniz.
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim t As Range
    
    Range("C3:N85").Interior.Color = xlNone

    For Each t In Range("C3:N85")
        If IsDate(t) = True Then
            t.NumberFormat = "dd.mm.yyyy"

            With t.Font
                .Name = "Calibri"
                .FontStyle = "İtalik"
                .Size = 11
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ThemeColor = xlThemeColorLight1
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
            With t.Interior
                .Pattern = xlPatternLinearGradient
                .Gradient.Degree = 45
                .Gradient.ColorStops.Clear
            End With
            With t.Interior.Gradient.ColorStops.Add(0)
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
            With t.Interior.Gradient.ColorStops.Add(1)
                .Color = 3145519
                .TintAndShade = 0
            End With
        
        End If
    Next t

End Sub
 
Katılım
14 Kasım 2021
Mesajlar
42
Excel Vers. ve Dili
Excell 2010 Türkçe
Merhaba,

Deneyiniz.
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim t As Range
   
    Range("C3:N85").Interior.Color = xlNone

    For Each t In Range("C3:N85")
        If IsDate(t) = True Then
            t.NumberFormat = "dd.mm.yyyy"

            With t.Font
                .Name = "Calibri"
                .FontStyle = "İtalik"
                .Size = 11
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ThemeColor = xlThemeColorLight1
                .TintAndShade = 0
                .ThemeFont = xlThemeFontMinor
            End With
            With t.Interior
                .Pattern = xlPatternLinearGradient
                .Gradient.Degree = 45
                .Gradient.ColorStops.Clear
            End With
            With t.Interior.Gradient.ColorStops.Add(0)
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
            With t.Interior.Gradient.ColorStops.Add(1)
                .Color = 3145519
                .TintAndShade = 0
            End With
       
        End If
    Next t

End Sub
Evet oldu istediğim teşekkür ederim.
 
Üst