ListBox Tarih Formatı

[noxious]

Sayın Hocalarım
Ekli dosyada Form da bir sorgulama işlemi var ve sorgudan sonra ListBox üzerinde tarih formatında ay ile gün yer değiştiriyor yani (22.09.2007) olması lazımken (9/22/2007) şeklinde oluyor.

Forumda bir kaç uygulama buldum ama kendi çalışmama uygulayamadım. En mantıklı kodu ikili ListBox çalışması üzerinde buldum ama uyarlayamadım bana yardım ederseniz sevinirim

Private Sub UserForm_Initialize()
For i = 1 To Cells(65536, 1).End(xlUp).Row
    ListBox1.AddItem Cells(i, 1) 'Sorunlu Format
Next i
For i = 1 To Cells(65536, 1).End(xlUp).Row
    ListBox2.AddItem Format(Cells(i, 1), "dd.mm.yyyy") 'İstediğim Format
Next i
End Sub

 

[Orion1]

Aşağıdaki şekilde denermisiniz?

For i = 1 To Cells(65536, 1).End(xlUp).Row
    ListBox2.AddItem Format(Cells(i, "I"), "dd.mm.yyyy")
Next i

 

[noxious]

Aşağıdaki şekilde denermisiniz?

For i = 1 To Cells(65536, 1).End(xlUp).Row
    ListBox2.AddItem Format(Cells(i, "I"), "dd.mm.yyyy")
Next i

Sayın Orion2 Hocam tekrar merhaba
Ben zaten sizin gönderdiğiniz şekilde kodu denedim kendi çalışmama ama olmadı
UserForm_Initialize kodları aşağıda

Private Sub UserForm_Initialize()
    Dim hwnd As Long
       hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", _
    "X", "D") & "Frame", Me.Caption)
    SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
    Sheets("Denetlemeler").Select
    adrs = Range(Cells(2, "I"), Cells(Cells(65536, "I").End(xlUp).Row, "I")).Address
    Calendar1 = CDate(WorksheetFunction.Min(Range(adrs)))
    Calendar2 = CDate(WorksheetFunction.Max(Range(adrs)))
End Sub

Benim UserForm initialize kodları bunlar ama buraya eklediğimde olmuyor. ayrıca CommandButton3_Click() içerisinede ekledim gene olmadı
commandButton3 kodu aşağıda

Private Sub CommandButton3_Click()
Dim sh As Worksheet
Dim bul As Range, rg As Range
Dim y As Integer, satir As Integer, x As Integer
Dim i As Integer, j As Integer
Dim arrSatir()
Dim arrveri()
Dim adres As String
If Trim(TextBox1) = Empty Then: ListBox2.Clear: TextBox2 = Empty: Exit Sub
Set sh = Sheets("Denetlemeler")
Set rg = sh.Range("AD1:AT65536")
'[A2] = Calendar1
 Sheets("Denetlemeler").Range("a2").AutoFilter Field:=9, Criteria1:=">=" & CDbl(Calendar1), Operator:=xlAnd _
        , Criteria2:="<=" & CDbl(Calendar2)
'[D2] = Calendar2
 Sheets("Denetlemeler").Range("a2").AutoFilter Field:=9, Criteria1:=">=" & CDbl(Calendar1), Operator:=xlAnd _
        , Criteria2:="<=" & CDbl(Calendar2)
Set bul = rg.Find(What:=TextBox1, Lookat:=xlPart)
ListBox2.Clear
ListBox2.ColumnWidths = "35;78;78;78;78;51;75;82;120;45;40;40;58;40;55;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;50;78;78;78;78;78;78;78;78;78;78;78;78"
TextBox2 = Empty
ListBox2.ColumnCount = 49
If bul Is Nothing Then
    MsgBox "[ " & TextBox1.Value & " ] İsimde bir MEMUR bulunamadı..!!", vbCritical, "B U L"
End If
If Not bul Is Nothing Then
   adres = bul.Address
   Do
      If bul.Row = satir Or bul.Row = 1 Then: GoTo f1
      satir = bul.Row
      ReDim Preserve arrSatir(x)
      arrSatir(x) = bul.Row
      x = x + 1
f1:
      Set bul = rg.FindNext(bul)
   Loop While Not bul Is Nothing And bul.Address <> adres
End If
On Error Resume Next
ReDim Preserve arrveri(UBound(arrSatir) + 1, 0)
arrveri(0, 0) = "Sıra No"
For i = 1 To UBound(arrSatir) + 1
    arrveri(i, 0) = sh.Cells(arrSatir(i - 1), 1)
Next i
ReDim Preserve arrveri(UBound(arrSatir) + 1, 4)
arrveri(0, 1) = "Görevli-1": arrveri(0, 2) = "Görevli-2"
arrveri(0, 3) = "Görevli-3": arrveri(0, 4) = "Görevli-4"
For i = 1 To UBound(arrSatir) + 1
    For j = 1 To 4
        arrveri(i, j) = sh.Cells(arrSatir(i - 1), j + 33)
    Next j
Next i
ReDim Preserve arrveri(UBound(arrSatir) + 1, 52)
For i = 1 To 48
    arrveri(0, i + 4) = sh.Cells(1, i + 1)
Next i
For i = 1 To UBound(arrSatir) + 1
    For j = 5 To 48
        arrveri(i, j) = sh.Cells(arrSatir(i - 1), j - 3)
    Next j
Next i
ListBox2.List = arrveri
ListBox2.ListIndex = 0
TextBox2 = ListBox2.ListCount - 1
a = ListBox2.ListCount
Erkek = 0
Kadın = 0
ECocuk = 0
KCocuk = 0
For i = 0 To a - 1
Erkek = Val(ListBox2.List(i, 15)) + Erkek
Kadın = Val(ListBox2.List(i, 16)) + Kadın
ECocuk = Val(ListBox2.List(i, 17)) + ECocuk
KCocuk = Val(ListBox2.List(i, 18)) + KCocuk
Next
TextBox4.Value = Erkek
TextBox5.Value = Kadın
TextBox6.Value = ECocuk
TextBox7.Value = KCocuk
Set sh = Nothing
End Sub

 

[Orion1]

Ekli dosyayı inceleyiniz.

 

[noxious]

Hocam cevabımı biliyorsunuz tek kelime ile harikasınız.
Dosya tamam kodları incelemeden sadece göz attım nerde hata yaptığımı sizin gönderdiğnizle kendi denemem arasında karşılaştırarak bulacağım. Tekrar teşekkürler saygılar

 

[Orion1]

Hocam cevabımı biliyorsunuz tek kelime ile harikasınız.
Dosya tamam kodları incelemeden sadece göz attım nerde hata yaptığımı sizin gönderdiğnizle kendi denemem arasında karşılaştırarak bulacağım. Tekrar teşekkürler saygılar

Rica ederim.
İyi çalışmalar.

 

[mesutcankaya]

Orion 1 hocam dosyayı tekrar paylaşabilir misiniz? aynı sorunu bende yaşıyorum