Office 365 uyum

[acebeci]

Office 365 de Dtpicker i çalıştıramıyorum. UserForm üzerindeki takvim eklentisini başka nasıl çalıştırabilirim bütün kodlarda Dtpicker'e göre yazılmıştı (tabi yine formdaki arkadaşlar tarafından)

Konu hakkında yardımcı olama imkanınız var mı acaba?


Private Sub CommandButton1_Click() 'Sorgula
Dim HaricSayfalar() As Variant, son_tarih As Date
HaricSayfalar = Array("YAZDIR", "CARİ", "RAPOR", "LİSTE", "ŞABLON")
ListBox1.Clear
If IsDate(DTPicker1) = False And DTPicker1 <> "Tümü" Then
MsgBox "İlk Tarih girişinde bir hata var. Lütfen kontrol edip, düzeltiniz", vbCritical, "UYARI"
Exit Sub
End If
If DTPicker1 <> "Tümü" Then Tarih = CDate(DTPicker1)
If IsDate(DTPicker2) = False And DTPicker2 <> "Tümü" Then
MsgBox "Son Tarih girişinde bir hata var. Lütfen kontrol edip, düzeltiniz", vbCritical, "UYARI"
Exit Sub
End If
If DTPicker2 <> "Tümü" Then son_tarih = CDate(DTPicker2)
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, 2).End(xlUp).Row
If DTPicker1.Value = "Tümü" Or DTPicker2.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
If sh.Cells(i, 17) = ComboBox7 Or ComboBox7 = "Tümü" Then
If sh.Cells(i, 18) = ComboBox8 Or ComboBox8 = "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
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 _
& ", Yükleme:" & ComboBox7 _
& ", İşcilik:" & ComboBox8


.Range("A5:AT10000").ClearContents
.Cells(4, 2).Resize(ListBox1.ListCount, 42) = ListBox1.List
For i = 4 To .Cells(65536, 2).End(xlUp).Row
Next i
End With
End Sub


Private Sub RefEdit1_BeforeDragOver(Cancel As Boolean, ByVal Data As MSForms.DataObject, ByVal x As stdole.OLE_XPOS_CONTAINER, ByVal y As stdole.OLE_YPOS_CONTAINER, ByVal DragState As MSForms.fmDragState, Effect As MSForms.fmDropEffect, ByVal Shift As Integer)

End Sub

Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 27 Then Unload Me
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, arryükleme() As Variant, arrişcilik() As Variant
Dim arrVeri() As Variant
Dim colTarlaS As New Collection, colKime As New Collection, colPlaka As New Collection, colCinsi As New Collection, colyükleme As New Collection, colişcilik As New Collection
Dim Toplam As Long, y As Long

HaricSayfalar = Array("YAZDIR", "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, 2).End(xlUp).Row - 3)
x = 0
Next

ReDim arrTarlaS(Toplam)
ReDim arrKime(Toplam)
ReDim arrPlaka(Toplam)
ReDim arrCinsi(Toplam)
ReDim arryükleme(Toplam)
ReDim arrişcilik(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, 2).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
arryükleme = sh.Cells(i, 17).Value
arrişcilik = sh.Cells(i, 18).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)
colyükleme.Add "Tümü", "Tümü": colyükleme.Add arryükleme(0), arryükleme(0)
colişcilik.Add "Tümü", "Tümü": colişcilik.Add arrişcilik(0), arrişcilik(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 colCinsi
If Eleman4 = arrCinsi(i) Then: w = w + 1
Next
If w = 0 Then colCinsi.Add arrCinsi(i), arrCinsi(i)
w = 0
For Each Eleman5 In colyükleme
If Eleman5 = arryükleme(i) Then: c = c + 1
Next
If c = 0 Then colyükleme.Add arryükleme(i), arryükleme(i)
c = 0
For Each Eleman6 In colişcilik
If Eleman6 = arrişcilik(i) Then: g = g + 1
Next
If g = 0 Then colişcilik.Add arrişcilik(i), arrişcilik(i)
g = 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
For Each Eleman In colyükleme: ComboBox7.AddItem Eleman: Next: ComboBox7.ListIndex = 0
For Each Eleman In colişcilik: ComboBox8.AddItem Eleman: Next: ComboBox8.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, 2).End(xlUp).Row
a = a + 1
arrVeri(a, 1) = Format(sh.Cells(i, 2), "dd.mm.yyyy")
For j = 2 To 22
arrVeri(a, j) = sh.Cells(i, j + 1)
Next j
Next i
End If
x = 0
Next
DTPicker1.Value = Date
DTPicker2.Value = Date
ListBox1.List = arrVeri
CommandButton2.Cancel = True
ComboBox5.AddItem "Tümü"
ComboBox5.ListIndex = 0
ComboBox6.AddItem "Tümü"
ComboBox6.ListIndex = 0
ComboBox7.AddItem "Tümü"
ComboBox7.ListIndex = 0
ComboBox8.AddItem "Tümü"
ComboBox8.ListIndex = 0
End Sub

 

[Levent Menteşoğlu]

Aşağıdaki linkte bulunan yönergeleri uygulayın.

https://www.excel.web.tr/threads/listview-date-and-time-picker-progressbar-diger-nesne-hatalarinin-coezuemleri.159385/#post-1133067

 

[acebeci]

Levent Abi bazı mücbir sebeplerden yeni cevap yazabildim kusura bakmayın ilginizden dolayı çok teşekkür ederim. Linkte ki yönergeleri takip ettim sorun çözüldü Abi.