Bu güne git hatalı çalışıyor

[herdogan]

Arkaşaların hazırladığı bir çalışmayı kendime uyarlamaya çalışıyorum.
Randevu formundaki takvime bu güne git eklemeye çalıştım. Eklediğim yerler aşağıdaki kodlar içerisinde sonlarda. İlk açılışta doğru çalışıyor. Fakat yıl yada ay değiştirince birden fazla günü işaretliyor. Bu günü tarihi kırmızı yazarak göstermesi gerekiyor. bir den fazla günü kırmızı yapıyor
Bunun dışında forma eklenecek bir butonlada bu güne gitmesi gerekiyor.

Dim intI As Integer, intJ As Integer, strnum As String
Dim gun1 As String, gun2 As String, bugun1 As String
Me.dolu = ""
For intI = 1 To 42
strnum = Format(intI, "00")
Me("lbl" & strnum).Caption = ""
Me("lbl" & strnum).Visible = True
Me("lbl" & strnum).BackColor = -2147483633
Me("lbl" & strnum).FontSize = 25
Me("lbl" & strnum).FontBold = True
Next intI
Set db = CurrentDb
intMonth = Me!cmbMonth
intYear = Me!cmbYear
intFirst = WeekDay(DateSerial(intYear, intMonth, 1), vbMonday)
intLastDay = Day(DateAdd("m", 1, DateSerial(intYear, intMonth, 1)) - 1)
intLast = intFirst + intLastDay - 1
intJ = 1
strSQL = "SELECT * From Srg WHERE süz=" & cmbMonth & "" & cmbYear
Set rst = db.OpenRecordset(strSQL)

For intI = intFirst To intLast
strnum = Format(intI, "00")

Me("lbl" & strnum).Caption = intJ

intJ = intJ + 1

Next intI
dolusay = 0
Do Until rst.EOF
gun2 = Day(rst![randevu tarihi])
For intI = 1 To 42
strnum = Format(intI, "00")

If Me("lbl" & strnum).Caption = gun2 Then
Me("lbl" & strnum).BackColor = 65280
dolusay = dolusay + 1

End If
Next intI

Me.dolu = "TAKVİMDE" & " " & dolusay & " " & "DOLU GÜN VE" & " " & intLastDay - dolusay & " " & "BOŞ GÜN VAR"

rst.MoveNext

Loop

If dolusay = 0 Then
Me.dolu = "BU AYDA HİÇ KAYIT YOK hepsi boş gözün aydın"
End If

If intLast < 36 Then
intJ = False
Else
intJ = True
End If

For intI = 1 To 42
strnum = Format(intI, "00")
If Me("lbl" & strnum).Caption = "" Then
Me("lbl" & strnum).Visible = False
End If

Next intI
'Burayı ekledim
bugun1 = Day(Me.[bugun])
For intI = 1 To 42
strnum = Format(intI, "00")

If Me("lbl" & strnum).Caption = bugun1 Then
Me("lbl" & strnum).ForeColor = 255

End If
Next intI

 

[modalı]

Sayın herdogan,

Yaptığım değişiklikler:

En başa:

For intI = 1 To 42
       
        strnum = Format(intI, "00")
   
        Me("lbl" & strnum).Caption = ""
   
   Me("lbl" & strnum).Visible = True
Me("lbl" & strnum).BackColor = -2147483633
Me("lbl" & strnum).FontSize = 25
Me("lbl" & strnum).FontBold = True
[COLOR=Red]Me("lbl" & strnum).ForeColor = vbBlack[/COLOR]
    Next intI

eklentisi ile tüm yazıları önce siyah yapmak gerekiyor.

2.En sona da

For intI = 1 To 42
    strnum = Format(intI, "00")
    [COLOR=Red]If Me("lbl" & strnum).Caption = Format(Day(Me.bugun), "00") And CInt(cmbMonth) = Month(Me.bugun) And CInt(Me.cmbYear) = Year(Me.bugun)[/COLOR] Then
    
    Me("lbl" & strnum).ForeColor = 255
     
     End If
         Next intI

Böylece hem ay hem de yıl kontrol ediliyor.

İyi çalışmalar

 

[assenucler]

Sayın Modalı;

Merhaba.. Günaydın..

Sayın herdogan'ın bu güzel çalışması ilgimi çekti ve indirip, sizin en alt kısma eklenmesini istediğiniz kodu yazınca, resimdeki hata iletisini alıyorum.

Ayrıca ANAFORM'a tıklayınca da 2. resimdeki gibi Makro1 hata mesajı veriyor. Nedeni hakkında bilgi verebilir misiniz?

Teşekkür...


Sayın herdogan;

Günaydın..
İlk mesajınızdaki dosyada VBA kodlarını göremiyorum. Nedeni ne olabilir?
Size de yanıtınız için önceden teşekkür..

 

[herdogan]

Sayın Modalı;
Teşekkürler
Sayın assnucler;
Randevu formunun herhangi bir olayından girerseniz veya VBA düzenleyiciden Randevu formunu seçerseniz bu formun bütün kodlarını görebilirsiniz. Sayın Modalının gönderdiği kodlar bende hata vermedi. Srg1 adlı sorgu randevu formu üzerinde günün randevularını gösteren liste kutusuna bilgi sağlıyor. form üzerinde metin192 den bilgi alıyor. Bu alanlarda dğişiklik yapmışsanız hata verir.
Ayrıca
Çalışma benim değil. Formdan bi arkadaşa ait. Ama kim olduğunu hatırlamıyorum