Skip to main content

AccessTr.neT


Takvim bu güne hatalı gidiyor

Takvim bu güne hatalı gidiyor

Çözüldü #1
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
.rar hastane.rar (Dosya Boyutu: 110,35 KB | İndirme Sayısı: 23)
Son Düzenleme: 10/08/2009, 23:02, Düzenleyen: herdogan.
Cevapla
Çözüldü #2
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?
Bana işe yarayan bir müdür göster,sana dünyayı yerinden oynatayım.
                                                                                        Descartes


Cevapla
Çözüldü #3
Sayın Bilgisayarcı;
Bu günün kırmızı olmasını istiyorum
Cevapla
Çözüldü #4
Kod:
Private Sub SetDays()
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
  
  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 db = CurrentDb
  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
    rst.MoveNext
  Loop
  
  For intI = 1 To 42
    strnum = Format(intI, "00")
    Me("lbl" & strnum).Visible = (Me("lbl" & strnum).Caption <> "")
  Next intI
  
  If dolusay = 0 Then
    Me.dolu = "BU AYDA HİÇ KAYIT YOK hepsi boş gözün aydın"
  Else
    Me.dolu = "TAKVİMDE" & " " & dolusay & " " & "DOLU GÜN VE" & " " & intLastDay - dolusay & " " & "BOŞ GÜN VAR"
  End If
' BİLGİSAYARCI'
  'Bugünü işaretlemek için yeter şart önce bu ayda mıyız?
  If (intMonth = Month(Now)) And (intYear = Year(Now)) Then
    'Bu aydayız
    gun1 = Day(Now)
    For intI = 1 To 42
      strnum = Format(intI, "00")
      If Me("lbl" & strnum).Caption = gun1 Then
        Me("lbl" & strnum).BackColor = vbBlue
        Exit For
      End If
    Next intI
  End If

End Sub

Bazı gereksiz işlemleri temizledim. Kodun okunabilirliği için düzenlemeler yaptım. En sonuna da gerekli olan kodu ekledim.
Kod:
' BİLGİSAYARCI'
  'Bugünü işaretlemek için yeter şart önce bu ayda mıyız?
  If (intMonth = Month(Now)) And (intYear = Year(Now)) Then
    'Bu aydayız
    gun1 = Day(Now)
    For intI = 1 To 42
      strnum = Format(intI, "00")
      If Me("lbl" & strnum).Caption = gun1 Then
        Me("lbl" & strnum).BackColor = vbBlue
        Exit For
      End If
    Next intI
  End If

Ben vbblue dedim onu vbred yapabilirsin. Kodun bütününe tam bakamadım ama hala gereksiz işlemler var gibi sanki
Bana işe yarayan bir müdür göster,sana dünyayı yerinden oynatayım.
                                                                                        Descartes


Cevapla
Çözüldü #5
Sayın bilgisayarcı;

Merhaba..

Hocam dosyayı göremiyorum. Acaba ilk mesaja mı eklediniz?

Teşekkürler..
Cevapla
Çözüldü #6
Dosya eklemedim .Kodun kendisini yazdım.
Bana işe yarayan bir müdür göster,sana dünyayı yerinden oynatayım.
                                                                                        Descartes


Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da
Task