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
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
Ekli dosyalar
-
110.3 KB Görüntüleme: 12
Son düzenleme: