15/01/2020, 16:57
Sayfalar: 1 2
15/01/2020, 18:15
"DateClicked" komutunu format() ile istediğiniz şekilde biçimlendirebilirsiniz
16/01/2020, 08:22
MultiSelect özelliği için kod buldum
Please place [ MonthView1 , CommandButton1 , CommandButton2 , ListBox1 ] in UserForm.
--- UserForm module ---
Please place [ MonthView1 , CommandButton1 , CommandButton2 , ListBox1 ] in UserForm.
--- UserForm module ---
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 Sub16/01/2020, 08:23
buda modul için
Please insert a class module and change the class name from "Class1" to "clsBoldMonthView".
--- Class module ( clsBoldMonthView ) ---
Please insert a class module and change the class name from "Class1" to "clsBoldMonthView".
--- Class module ( clsBoldMonthView ) ---
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 Function16/01/2020, 08:34
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ı
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ı
16/01/2020, 08:47
istediğimiz tarih formatına göre almak için şöyle yazmak yeterliymiş
ctl.Value = Format(DateClicked, "dd.mm.yyyy")
ctl.Value = Format(DateClicked, "dd.mm.yyyy")
Sayfalar: 1 2