Post by mysz leÅnaKontrolki z MSCOMCTL.OCX mogą chyba jednak zostać ...
Można podejść mniej konserwatywnie i jednak z powodzeniem stosować
mscomct2, a w sumie DatePickera właśnie :-)
Ale trzeba się liczyć z nieprzewidzianymi kłopotami! Wymaga to testów i
dobrej obsługi ewentualnych błędów. Stąd nie każdy je stosuje.
DatePickera mam wdrożonego w całkiem sporym projekcie klienta do MSSQL w
Access 2007 pod RT2007. Działa bez zarzutu i jest ułatwieniem w pracy
(zaznaczanie zakresu dat myszą, pogrubianie wybranych dni na kalendarzu
i wiele innych).
Pozdrawiam
--
Maciej Tokarz
http://my-poi.pl
A tu kawałek kodu:
Option Compare Database
Private Const moduleName = "Form_UrlopyAdd"
Private Const rok = "2011"
Dim m As New MonthView
Dim dniWolne As New Scripting.Dictionary
Private Sub Form_Load()
On Error GoTo Blad
' wczytaj dni wolne
Dni_Wolne
Set m = Me.Kalendarz.Object
m.MaxDate = DateSerial(rok + 1, 1, 1) - 1
m.MinDate = DateSerial(rok, 1, 1)
m.MaxSelCount = 31
m.TitleBackColor = RGB(255, 230, 120)
' wypełnienie GetDayBold
m.Value = DateSerial(rok, 1, 1)
Zakoncz:
Exit Sub
Blad:
Error_Show moduleName, "Form_Load", Err
Resume Zakoncz
End Sub
Private Sub Dni_Wolne()
On Error GoTo Blad
Dim rst As ADODB.Recordset
Dim sql As String
' otwórz połączenie
'Cnn_Open
' utwórz recordset
Set rst = New ADODB.Recordset
' ustaw recordset
rst.ActiveConnection = Application.CurrentProject.Connection
rst.CursorLocation = adUseClient
rst.CursorType = adOpenStatic
rst.LockType = adLockReadOnly
' zapytanie
sql = _
"SELECT Dzien " & _
"FROM DniWolne " & _
"WHERE (Year(Dzien) = '" & rok & "')"
' otwórz recordset
rst.Open sql
Dim i As Integer
For i = 0 To rst.RecordCount - 1
dniWolne.Add Format(rst(0), "yyyy-MM-dd"), i
rst.MoveNext
Next
' zamknij recordset
rst.Close
Set rst = Nothing
' zamknij połączenie
'Cnn_Close
Zakoncz:
Exit Sub
Blad:
' dodatkowe sprawdzenie stanu połączenia
If Not cnn Is Nothing Then
If cnn.State = 1 Then
cnn.Close
Set cnn = Nothing
End If
End If
Error_Show moduleName, "Dni_Wolne", Err
Resume Zakoncz
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set m = Nothing
End Sub
Private Sub Kalendarz_GetDayBold(ByVal StartDate As Date, ByVal Count As
Integer, State() As Boolean)
On Error GoTo Blad
Dim myBold As Integer
Dim d As Date
myBold = 5
While myBold < Count
State(myBold) = True
myBold = myBold + 7
Wend
myBold = 6
While myBold < Count
State(myBold) = True
myBold = myBold + 7
Wend
d = StartDate
For myBold = 0 To Count
Debug.Print dniWolne(1)
If dniWolne.Exists(Format(d, "yyyy-MM-dd")) Then State(myBold)
= True
d = DateAdd("d", 1, d)
Next
Zakoncz:
Exit Sub
Blad:
Error_Show moduleName, "Kalendarz_GetDayBold", Err
Resume Zakoncz
End Sub
Private Sub Kalendarz_SelChange(ByVal StartDate As Date, ByVal EndDate
As Date, Cancel As Boolean)
On Error GoTo Blad
Dim uDataP As Date
Dim uDataK As Date
Dim uLength As Integer
uDataP = DataP(StartDate)
uDataK = DataK(EndDate)
uLength = Urlop_Wymiar(StartDate, EndDate)
If uLength > 0 Then
Me.Wymiar.Caption = _
"Początek: " & uDataP & vbNewLine & _
"Koniec: " & uDataK & vbNewLine & _
"Wymiar: " & uLength
Else
Me.Wymiar.Caption = "Zaznacz urlop"
End If
Zakoncz:
Exit Sub
Blad:
Error_Show moduleName, "Kalendarz_SelChange", Err
Resume Zakoncz
End Sub
Private Function Urlop_Wymiar(p As Date, k As Date) As Integer
On Error GoTo Blad
Dim d As Date
Dim i As Integer
i = DateDiff("d", p, k) + 1
For d = p To k
If m.DayBold(d) = True Then
i = i - 1
End If
Next
Urlop_Wymiar = i
Zakoncz:
Exit Function
Blad:
Error_Show moduleName, "Urlop_Wymiar", Err
Resume Zakoncz
End Function
Private Function DataP(p As Date) As Date
On Error GoTo Blad
Do While m.DayBold(p) = True
p = DateAdd("d", 1, p)
Loop
DataP = p
Zakoncz:
Exit Function
Blad:
If Err.Number = 35773 Then Resume Zakoncz
Error_Show moduleName, "DataP", Err
Resume Zakoncz
End Function
Private Function DataK(k As Date) As Date
On Error GoTo Blad
Do While m.DayBold(k) = True
k = DateAdd("d", -1, k)
Loop
DataK = k
Zakoncz:
Exit Function
Blad:
If Err.Number = 35773 Then Resume Zakoncz
Error_Show moduleName, "DataK", Err
Resume Zakoncz
End Function