Koşullu Renklendirme

Private Sub Form_Current()
On Error GoTo hata
    If Nz(resim, "") = "" Then
        Me.cerceve.Picture = CurrentProject.Path & "\resimyok.jpg"
    Else
        Me.cerceve.Picture = resim
    End If
Exit_hata:
    Exit Sub
 
hata:
    MsgBox "Resim bulunamadı.." _
           & Chr(10) & "Resim dosyanız silinmiş," _
           & " yeri veya ismi değişmiş olabilir..", vbInformation, "Hata"
           Me.cerceve.Picture = ""
    Resume Exit_hata
End Sub

Dim GSure, GYas, GSKYil As Integer
' GYas: Kişinin Yaşı
' GSure: 45 yaşına kadar 5 yılda bir 45 - 55 yaşları arasında 3 yılda bir 55 yaşından büyükse 2 yılda bir
' GSKYil: Kontrol tarihinine göre geçen yıl sayısı
GYas = Abs(DateDiff("yyyy", [dogum_tarihi], Date)) - IIf(Format([dogum_tarihi], "mmddhhnnss") <= Format$(Date, "mmddhhnnss"), 0, 1)
GSure = IIf(GYas > 55, "2", IIf(GYas >= 45 And GYas <= 55, "3", "5"))
GSKYil = IIf(IsNull(Me.saglık_kontrol), "0", Abs(DateDiff("yyyy", [saglık_kontrol], Date)) - IIf(Format([saglık_kontrol], "mmddhhnnss") <= Format$(Date, "mmddhhnnss"), 0, 1))
If GSKYil = GSure Or GSKYil > GSure Then
    Me.saglık_kontrol.BackColor = vbRed
Else
    Me.saglık_kontrol.BackColor = vbWhite
End If

Merhaba,

Tüm kodlar End Sub ile biter. Siz end sub ile formun geçerli olduğunda olayına yazdığınız kodu bitirdikten sonra benim verdiğim kodu yazmışsınız. Bu şekilde hiçbir kodu çalıştıramazsınız.

Sizin kodunuz bu,

    If Nz(resim, "") = "" Then

        Me.cerceve.Picture = CurrentProject.Path & "\resimyok.jpg"

    Else

        Me.cerceve.Picture = resim

    End If

Diğerleri ise hata durumunda çalışacak kodlar

Exit_hata:

    Exit Sub

 

hata:

    MsgBox "Resim bulunamadı.." _

           & Chr(10) & "Resim dosyanız silinmiş," _

           & " yeri veya ismi değişmiş olabilir..", vbInformation, "Hata"

           Me.cerceve.Picture = ""

    Resume Exit_hata

Kodu aşağıdaki gibi uygulamanız gerekiyor.

Private Sub Form_Current()

On Error GoTo hata



Dim GSure, GYas, GSKYil As Integer



If Nz(resim, "") = "" Then

Me.cerceve.Picture = CurrentProject.Path & "\resimyok.jpg"

Else

Me.cerceve.Picture = resim

End If





' GYas: Kişinin Yaşı

' GSure: 45 yaşına kadar 5 yılda bir 45 - 55 yaşları arasında 3 yılda bir 55 yaşından büyükse 2 yılda bir

' GSKYil: Kontrol tarihinine göre geçen yıl sayısı



GYas = Abs(DateDiff("yyyy", [dogum_tarihi], Date)) - IIf(Format([dogum_tarihi], "mmddhhnnss") <= Format$(Date, "mmddhhnnss"), 0, 1)

GSure = IIf(GYas > 55, "2", IIf(GYas >= 45 And GYas <= 55, "3", "5"))



GSKYil = IIf(IsNull(Me.saglık_kontrol), "0", Abs(DateDiff("yyyy", [saglık_kontrol], Date)) - IIf(Format([saglık_kontrol], "mmddhhnnss") <= Format$(Date, "mmddhhnnss"), 0, 1))



If GSKYil = GSure Or GSKYil > GSure Then

Me.saglık_kontrol.BackColor = vbRed

Else

Me.saglık_kontrol.BackColor = vbWhite



End If







Exit_hata:

Exit Sub



hata:

MsgBox "Resim bulunamadı.." _

& Chr(10) & "Resim dosyanız silinmiş," _

& " yeri veya ismi değişmiş olabilir..", vbInformation, "Hata"

Me.cerceve.Picture = ""

Resume Exit_hata



End Sub

Sayın ozanakkaya, tam istediğim gibi çalışıyor değerli yardımınız için çok teşekkür ederim, iyi akşamlar.