Takvim bu güne hatalı gidiyor - Baskı Önizleme +- AccessTr.neT (https://accesstr.net) +-- Forum: Microsoft Access (https://accesstr.net/forum-microsoft-access.html) +--- Forum: Access Cevaplanmış Soruları (https://accesstr.net/forum-access-cevaplanmis-sorulari.html) +--- Konu Başlığı: Takvim bu güne hatalı gidiyor (/konu-takvim-bu-gune-hatali-gidiyor.html) |
Takvim bu güne hatalı gidiyor - herdogan - 10/08/2009 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. Günü kırmızı yazıl ile 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 Cvp: Takvim bu güne hatalı gidiyor - Bilgisayarcı - 11/08/2009 Ben yapılmak isteneni tam anlayamadığım için soruyorum. Bugün 'ün kırmızı renkte mi olmasını istiyorsunuz? Yoksa bir düğme koyayım o direkt olarak takvimde bugünü ( dolayısıyla bu ayı) açsın mı istiyorsunuz? Cvp: Takvim bu güne hatalı gidiyor - herdogan - 11/08/2009 Sayın Bilgisayarcı; Bu günün kırmızı olmasını istiyorum Cvp: Takvim bu güne hatalı gidiyor - Bilgisayarcı - 11/08/2009 Kod:
Private Sub SetDays() Kod:
' BİLGİSAYARCI' Cvp: Takvim bu güne hatalı gidiyor - assenucler - 11/08/2009 Sayın bilgisayarcı; Merhaba.. Hocam dosyayı göremiyorum. Acaba ilk mesaja mı eklediniz? Teşekkürler.. Cvp: Takvim bu güne hatalı gidiyor - Bilgisayarcı - 11/08/2009 Dosya eklemedim .Kodun kendisini yazdım. |