Calendar da tarihi güncel tutma

[acebeci]

Değerli arkadaşlar bir userfom da calendar kullandım(daha önceki bilgisayarımda DTPicker kulanmıştım bu bilgayarıma DTPicker i yükleyemedim o yüzden aslında DTPicker daha kullanışlı oluyordu ama ofis 2007 ile DTPickeri çalıştıramadım) o calendar da tarihi her açtığımda o günün tari yani güncel tarihi nasıl yapabilirim yardım edebilirseniz sevinirim şimdiden hepinize çok teşekkür ederim

 

[Ferhat Pazarçevirdi]

Nesnenin bir Userform üzerinde konumlandırıldığı ve Nesne adınızın Calendar1 olduğu kabuluyle;

Userformun Inıtialize koduna; aşağıdaki satırı ilave ediniz.

Calendar1.Value=Date

 

[acebeci]

Sayın Ferhat bey öncelikle alakanızdan dolayı çok teşekkür ederim.User formdaki kodlarım aşağıdaki gibi acaba nereye yazmalıyım.Birde Calender uygulamasını sonradan ben ekledim acaba yanlış yaptığım birşey falan varmı yoksa herşey yolundamı.Paylaşımcı ruhunuzu birkez daha tebrik eder çalışmalarınızda başarılar dilerim.

Private Sub CommandButton1_Click() 'Sorgula
Dim HaricSayfalar() As Variant, son_tarih As Date
HaricSayfalar = Array("CARİ", "RAPOR", "LİSTE", "ŞABLON")
ListBox1.Clear
If IsDate(Calendar1) = False And Calendar1 <> "Tümü" Then
MsgBox "İlk Tarih girişinde bir hata var. Lütfen kontrol edip, düzeltiniz", vbCritical, "UYARI"
Exit Sub
End If
If Calendar1 <> "Tümü" Then tarih = CDate(Calendar1)
If IsDate(Calendar2) = False And Calendar2 <> "Tümü" Then
MsgBox "Son Tarih girişinde bir hata var. Lütfen kontrol edip, düzeltiniz", vbCritical, "UYARI"
Exit Sub
End If
If Calendar2 <> "Tümü" Then son_tarih = CDate(Calendar2)
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 4 To sh.Cells(65536, 3).End(xlUp).Row
If Calendar1.Value = "Tümü" Or Calendar2.Value = "Tümü" Or sh.Cells(i, 2) >= tarih _
And sh.Cells(i, 2) <= son_tarih Then
If sh.Cells(i, 3) = ComboBox2 Or ComboBox2 = "Tümü" Then
If sh.Cells(i, 4) = ComboBox3 Or ComboBox3 = "Tümü" Then
If sh.Cells(i, 5) = ComboBox4 Or ComboBox4 = "Tümü" Then
If sh.Cells(i, 9) = ComboBox6 Or ComboBox6 = "Tümü" Then
With ListBox1
.AddItem Format(sh.Cells(i, 2), "dd.mm.yyyy")
For j = 1 To 22
.List(ListBox1.ListCount - 1, j) = sh.Cells(i, j + 2)
Next j
' .List(ListBox1.ListCount - 1, 1) = sh.Cells(i, 1)
' .List(ListBox1.ListCount - 1, 2) = sh.Cells(i, 2)
' .List(ListBox1.ListCount - 1, 3) = sh.Cells(i, 3)
End With
End If
End If
End If
End If
End If
Next i
End If
x = 0
Next
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
sirala
With Sheets("Rapor")
.Cells(2, 1) = "SORGU -> Tarih:" & ComboBox1 _
& ", Tarla Sahibi:" & ComboBox2 _
& ", Kime Gittiği:" & ComboBox3 _
& ", Plaka:" & ComboBox4 _
& ", Cinsi:" & ComboBox6

.Range("A4:X10000").ClearContents
.Cells(4, 2).Resize(ListBox1.ListCount, 23) = ListBox1.List
For i = 4 To .Cells(65536, 2).End(xlUp).Row
y = y + 1
.Cells(i, 1) = y
Next i
End With
End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Initialize()
Dim HaricSayfalar() As Variant
Dim sh As Object
Dim arrTarlaS() As Variant, arrKime() As Variant, arrPlaka() As Variant, arrCnisi() As Variant
Dim arrVeri() As Variant
Dim colTarlaS As New Collection, colKime As New Collection, colPlaka As New Collection, colCinsi As New Collection
Dim Toplam As Long, y As Long

HaricSayfalar = Array("CARİ", "RAPOR", "LİSTE", "ŞABLON")
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then: Toplam = Toplam + (sh.Cells(65536, 3).End(xlUp).Row - 3)
x = 0
Next

ReDim arrTarlaS(Toplam)
ReDim arrKime(Toplam)
ReDim arrPlaka(Toplam)
ReDim arrCinsi(Toplam)
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 5 To sh.Cells(65536, 3).End(xlUp).Row
arrTarlaS = sh.Cells(i, 3).Value
arrKime = sh.Cells(i, 4).Value
arrPlaka = sh.Cells(i, 5).Value
arrCinsi = sh.Cells(i, 9).Value
y = y + 1
Next i
End If
x = 0
Next
On Error Resume Next
colTarlaS.Add "Tümü", "Tümü": colTarlaS.Add arrTarlaS(0), arrTarlaS(0)
colKime.Add "Tümü", "Tümü": colKime.Add arrKime(0), arrKime(0)
colPlaka.Add "Tümü", "Tümü": colPlaka.Add arrPlaka(0), arrPlaka(0)
colCinsi.Add "Tümü", "Tümü": colCinsi.Add arrCinsi(0), arrCinsi(0)
For i = 0 To UBound(arrTarlaS) - 1

For Each Eleman1 In colTarlaS
If Eleman1 = arrTarlaS(i) Then: x = x + 1
Next
If x = 0 Then colTarlaS.Add arrTarlaS(i), arrTarlaS(i)
x = 0

For Each Eleman2 In colKime
If Eleman2 = arrKime(i) Then: y = y + 1
Next
If y = 0 Then colKime.Add arrKime(i), arrKime(i)
y = 0

For Each Eleman3 In colPlaka
If Eleman3 = arrPlaka(i) Then: Z = Z + 1
Next
If Z = 0 Then colPlaka.Add arrPlaka(i), arrPlaka(i)
Z = 0
For Each Eleman4 In colPlaka
If Eleman4 = arrCinsi(i) Then: w = w + 1
Next
If w = 0 Then colCinsi.Add arrCinsi(i), arrCinsi(i)
w = 0
Next
ComboBox1.AddItem "Tümü": ComboBox1.ListIndex = 0
For Each Eleman In colTarlaS: ComboBox2.AddItem Eleman: Next: ComboBox2.ListIndex = 0
For Each Eleman In colKime: ComboBox3.AddItem Eleman: Next: ComboBox3.ListIndex = 0
For Each Eleman In colPlaka: ComboBox4.AddItem Eleman: Next: ComboBox4.ListIndex = 0
For Each Eleman In colCinsi: ComboBox6.AddItem Eleman: Next: ComboBox6.ListIndex = 0

With ListBox1
.Clear
.ColumnCount = 4
.ColumnWidths = "100;135;112;100"
End With

ReDim arrVeri(1 To Toplam, 1 To 23)

For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 4 To sh.Cells(65536, 3).End(xlUp).Row
a = a + 1
arrVeri(a, 1) = Format(sh.Cells(i, 2), "dd.mm.yyyy")
For j = 2 To 23
arrVeri(a, j) = sh.Cells(i, j + 1)
Next j
Next i
End If
x = 0
Next
ListBox1.List = arrVeri
CommandButton2.Cancel = True
ComboBox5.AddItem "Tümü"
ComboBox5.ListIndex = 0
ComboBox6.AddItem "Tümü"
ComboBox6.ListIndex = 0
End Sub