Skip to main content

AccessTr.neT


Excel Date Picker

Excel Date Picker

Çözüldü #1
Seçtiğimiz tarih ay.gün.yıl şeklinde geliyor bunu gün.ay. yıl şekline nasıl çevirebiliriz
.rar Date Picker.rar (Dosya Boyutu: 22,89 KB | İndirme Sayısı: 3)
@benbendedeilem
Son Düzenleme: 15/01/2020, 16:58, Düzenleyen: accessman.
Cevapla
#2
"DateClicked" komutunu format() ile istediğiniz şekilde biçimlendirebilirsiniz
Cevapla
#3
MultiSelect özelliği için kod buldum

Please place [ MonthView1 , CommandButton1 , CommandButton2 , ListBox1 ] in UserForm.

[b]--- UserForm module ---[/b]


Kod
Private WithEvents BoldMonthView As clsBoldMonthView

Private Sub UserForm_Initialize()
    Set BoldMonthView = New clsBoldMonthView
    Set BoldMonthView.MonthView = MonthView1
End Sub

Private Sub UserForm_Terminate()
    Set BoldMonthView = Nothing
End Sub

Private Sub BoldMonthView_DateClick(ByVal DateClicked As Date, ByVal BoldState As Boolean)
'    MsgBox DateClicked & " ( " & BoldState & " )"
End Sub

Private Sub CommandButton1_Click()
Dim Temp As Collection
Dim i As Integer
    ListBox1.Clear
    Set Temp = BoldMonthView.BoldStaes
    If (Temp.Count > 0) Then
        For i = 1 To Temp.Count
            ListBox1.AddItem Format(Temp.Item(i), "yyyy/mm/dd")
        Next i
    End If
End Sub

Private Sub CommandButton2_Click()
    BoldMonthView.Reset
    ListBox1.Clear
End Sub
Cevapla
#4
buda modul için

Please insert a class module and change the class name from "Class1" to "clsBoldMonthView".

[b]--- Class module ( clsBoldMonthView ) ---[/b]



Kod
Public Event DateClick(ByVal DateClicked As Date, ByVal BoldState As Boolean)
Private WithEvents MyMonthView As MonthView

Private colBoldDate As Collection   'Bold-faced days collection

Private Sub Class_Initialize()
    Set colBoldDate = New Collection
End Sub

Private Sub Class_Terminate()
    Set colBoldDate = Nothing
    Set MyMonthView = Nothing
End Sub

Public Property Set MonthView(ByVal Target As MonthView)
    Set MyMonthView = Target
End Property

Public Property Get BoldStaes() As Collection
Dim temp As Collection
Dim DateArray() As Date
Dim i As Integer
    Set temp = New Collection
    If (colBoldDate.Count > 0) Then
        DateArray = CollectionDateSort
        For i = 1 To UBound(DateArray)
            temp.Add DateArray(i)
        Next i
    End If
    Set BoldStaes = temp
End Property

Public Sub Reset()
    Set colBoldDate = New Collection
    Call SetDayBold
End Sub

Private Sub MyMonthView_Click()
    'Bold-faced setting with the change of the month
    Call SetDayBold
End Sub

Private Sub MyMonthView_DateClick(ByVal DateClicked As Date)
Dim Bold_State As Boolean
    With MyMonthView
        'Check whether the day is set to a bold-face
        If (ChkDayCol(DateClicked) = False) Then
            'Set Bold-face
            colBoldDate.Add Item:=DateClicked, _
                            Key:=Format(DateClicked, "yyyy/mm/dd")
            .DayBold(DateClicked) = True
            Bold_State = True
        Else
            'Reset Bold-face
            colBoldDate.Remove Index:=Format(DateClicked, "yyyy/mm/dd")
            .DayBold(DateClicked) = False
            Bold_State = False
        End If
    End With
    
    'For the case that clicked a part of the last month or the next month.
    Call SetDayBold
    
    RaiseEvent DateClick(DateClicked, Bold_State)
End Sub

'Set a registration date to a bold-face
Private Sub SetDayBold()
Dim i As Integer
Dim temp As Date
    With MyMonthView
        If (colBoldDate.Count = 0) Then
            For temp = .VisibleDays(1) To .VisibleDays(42)
                .DayBold(temp) = False    'for [Reset] method
            Next temp
        Else
            For i = 1 To colBoldDate.Count
                If (colBoldDate(i) >= .VisibleDays(1)) And _
                   (colBoldDate(i) <= .VisibleDays(42)) Then
                    .DayBold(colBoldDate(i)) = True
                End If
            Next i
        End If
    End With
End Sub

'Check having bold-faced setting or not
Private Function ChkDayCol(ByVal ChkDate As Date) As Boolean
Dim dmy As Date
    On Error Resume Next
    dmy = colBoldDate.Item(Format(ChkDate, "yyyy/mm/dd"))
    If (Err.Number = 0) Then
        ChkDayCol = True
    Else
        ChkDayCol = False
    End If
    Err.Clear
End Function

Private Function CollectionDateSort() As Variant
Dim DateArray() As Date
Dim vntTemp1 As Date
Dim vntTemp2 As Date
Dim blnContinue As Boolean
Dim gap As Long
Dim i As Long

    If (colBoldDate.Count = 0) Then
        Exit Function
    End If
    
    ReDim DateArray(1 To colBoldDate.Count)
    For i = 1 To colBoldDate.Count
        DateArray(i) = colBoldDate.Item(i)
    Next i

'=== Date order sort by ComSort11 algorithm ===
    gap = colBoldDate.Count - 1
    blnContinue = True
    
    Do While (gap > 1) Or (blnContinue = True)
        gap = Int(CDbl(gap) / 1.3)
        If (gap = 9) Or (gap = 10) Then
            gap = 11
        ElseIf (gap < 1) Then
            gap = 1
        End If

        blnContinue = False
        For i = 1 To (colBoldDate.Count - gap)
            If ((DateArray(i) > DateArray(i + gap))) Then
                vntTemp1 = DateArray(i)
                vntTemp2 = DateArray(i + gap)
                DateArray(i) = vntTemp2
                DateArray(i + gap) = vntTemp1
                blnContinue = True
            End If
        Next i
    Loop
    
    CollectionDateSort = DateArray
End Function
Cevapla
#5
ben bu kodları ekledim ama nasıl kullanılacağını bilmiyorum 
link eklemek yasak olduğu için paylaşamıyorum
oradaki açıklamaları da buraya hepsini ekleyemem
ama date pickerda multiselect denemiş olan var mı
Cevapla
#6
istediğimiz tarih formatına göre almak için şöyle yazmak yeterliymiş

ctl.Value = Format(DateClicked, "dd.mm.yyyy")
Cevapla

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

Yorum yapmak için üye olmanız gerekiyor

ya da