Koşullu Biçimlendirilmiş hücre renginin textboxta gösterilmesi

[angurya]

Mrb.

Koşullu biçimlendirilen hücre renginin textboxa almak istiyorum


örnek dosya ektedir.

teşekürler

 

[ozgretmen]

Dosyanız nerede ?

 

[angurya]

Eklenmiş Dosyalar atr_takip.zip (22 Byte, 0 Görüntülenme)

 

[Korhan Ayhan]

Selamlar,

Eklemiş olduğunuz eklenti içeriğinde dosya görünmüyor. Sanırım bir hata oldu. Tekrar eklermisiniz.

 

[angurya]

Dosyayı tekrar ekledim.
Sanırım bir hata olmuş.

 

[Korhan Ayhan]

Selamlar,

Kayıtlar arasında gezinmek için kullandığınız kodları aşağıdaki şekilde değiştirip denermisiniz.

Private Sub cmdEnBas_Click()
    txtSira = Cells(2, 1)
    cbFirma = Cells(2, 2)
    txtBelge = Cells(2, 3)
    txtBelgetarih = Cells(2, 4)
    txtTalep = Cells(2, 5)
    txtTakip = Cells(2, 6)
    If (Val(Date) - Val(Cells(2, 6)) <= 6) And (Val(Cells(2, 6)) <= Val(Date)) Then
    txtTakip.BackColor = &HFF80FF
    Else
    txtTakip.BackColor = &H80000005
    End If
    txtDosya = Cells(2, 7)
End Sub
 
Private Sub cmdEnSon_Click()
    Dim say As Integer
    say = WorksheetFunction.CountA(Range("A1:A65000"))
    txtSira = Cells(say, 1)
    cbFirma = Cells(say, 2)
    txtBelge = Cells(say, 3)
    txtBelgetarih = Cells(say, 4)
    txtTalep = Cells(say, 5)
    txtTakip = Cells(say, 6)
    If (Val(Date) - Val(Cells(say, 6)) <= 6) And (Val(Cells(say, 6)) <= Val(Date)) Then
    txtTakip.BackColor = &HFF80FF
    Else
    txtTakip.BackColor = &H80000005
    End If
    txtDosya = Cells(say, 7)
End Sub
 
Private Sub cmdGeri_Click()
    If txtSira = 1 Then
        Exit Sub
    Else
        txtSira = txtSira - 1
        cbFirma = Cells(txtSira + 1, 2)
        txtBelge = Cells(txtSira + 1, 3)
        txtBelgetarih = Cells(txtSira + 1, 4)
        txtTalep = Cells(txtSira + 1, 5)
        txtTakip = Cells(txtSira + 1, 6)
        If (Val(Date) - Val(Cells(txtSira + 1, 6)) <= 6) And (Val(Cells(txtSira + 1, 6)) <= Val(Date)) Then
        txtTakip.BackColor = &HFF80FF
        Else
        txtTakip.BackColor = &H80000005
        End If
        txtDosya = Cells(txtSira + 1, 7)
    End If
End Sub
 
Private Sub cmdIleri_Click()
    Dim say As Integer
    say = WorksheetFunction.CountA(Range("A1:A65000"))
    If txtSira = say Then
        Exit Sub
    Else
        txtSira = txtSira + 1
        cbFirma = Cells(txtSira + 1, 2)
        txtBelge = Cells(txtSira + 1, 3)
        txtBelgetarih = Cells(txtSira + 1, 4)
        txtTalep = Cells(txtSira + 1, 5)
        txtTakip = Cells(txtSira + 1, 6)
        If (Val(Date) - Val(Cells(txtSira + 1, 6)) <= 6) And (Val(Cells(txtSira + 1, 6)) <= Val(Date)) Then
        txtTakip.BackColor = &HFF80FF
        Else
        txtTakip.BackColor = &H80000005
        End If
        txtDosya = Cells(txtSira + 1, 7)
    End If
End Sub

 

[angurya]

Korhan Bey ilginiz için çok teşekkür ederim. Kodlar sorunsuz çalıştı.
Saygılarımla.