Skip to main content

AccessTr.neT


Koşullu Renklendirme

Koşullu Renklendirme

#7
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
Cevapla
#8
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
Cevapla
#9
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.
Son Düzenleme: 19/10/2017, 22:43, Düzenleyen: ertans.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da