Konu Araçları | Seçenekler: | Gösterim Stili
Tarih
10/08/2009 20:57
Konu Sahibi
herdogan
Yorumlar
12
Okunma
3539
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 0/5 - 0 oy

herdogan

Hesap Aktif Değil
Kullanici Avatari
Aktivasyon Bekleyen
130
21/12/2008
Edirne
Ofis 2003
10/06/2016,21:25
Çözüldü 
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


Ek Dosyalar
.rar   hastane.rar (Dosya Boyutu: 110,35 KB / İndirme Sayısı: 23)
Cevapla

Bilgisayarcı

Atçalı
Kullanici Avatari
Aktif Üye
657
29/01/2008
410
Antalya
Ofis 2003
01/11/2011,15:17
Çözüldü 
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

herdogan

Hesap Aktif Değil
Kullanici Avatari
Aktivasyon Bekleyen
130
21/12/2008
Edirne
Ofis 2003
10/06/2016,21:25
Çözüldü 
Sayın Bilgisayarcı;
Bu günün kırmızı olmasını istiyorum


Cevapla

Bilgisayarcı

Atçalı
Kullanici Avatari
Aktif Üye
657
29/01/2008
410
Antalya
Ofis 2003
01/11/2011,15:17
Çözüldü 

Kod:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
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:
1
2
3
4
5
6
7
8
9
10
11
12
13
' 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

assenucler

Aktif Üye
Kullanici Avatari
Aktif Üye
A.... S.... Ş....
2.054
31/10/2008
63
İstanbul
-
01/09/2017,15:34
Çözüldü 
Sayın bilgisayarcı;

Merhaba..

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

Teşekkürler..


Cevapla

Bilgisayarcı

Atçalı
Kullanici Avatari
Aktif Üye
657
29/01/2008
410
Antalya
Ofis 2003
01/11/2011,15:17
Çözüldü 
Dosya eklemedim .Kodun kendisini yazdım.


Bana işe yarayan bir müdür göster,sana dünyayı yerinden oynatayım.
                                                                                        Descartes


Cevapla


Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Tarih Son Yorum
Çözüldü TAKVİM renklendirme ve listeleme 2 Doğan Uludüz 2 360 18/02/2017, 18:24 Doğan Uludüz
Çözüldü TAKVİM renklendirme ve listeleme Doğan Uludüz 6 481 14/02/2017, 15:49 Doğan Uludüz
Çözüldü Raporda doğru fakat pdf yapınca hatalı değerler kadirdursun 10 781 18/01/2017, 17:17 kadirdursun
Çözüldü Rapora, seçilen güne ait bilanço eklenmesi ertans 10 673 26/12/2016, 17:07 atoz112
Çözüldü tablodaki verilerin silinmeden ertesi güne yeni kayıt açılması dayko 10 1.057 25/08/2016, 11:42 dayko

Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2017 MyBB Group.
Forum use Krzysztof "Supryk" Supryczynski addons.