![]() ![]() ![]() ![]() |
|||||
|
|||||
樓主 ski ![]()
![]() |
------------- Option Compare Database Private Sub cmdRefresh_Click() Call Datejc End Sub Private Sub Form_Load() ' On Error Resume Next DoCmd.Restore Call HideDbWindow(0) Me.年份.Caption = Year(Date) Call Datejc End Sub Private Sub 上年_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Me.上年.SpecialEffect = 2 End Sub Private Sub 上年_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Me.上年.SpecialEffect = 3 Me.年份.Caption = Me.年份.Caption - 1 Call Datejc End Sub Private Sub 下年_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Me.下年.SpecialEffect = 2 End Sub Private Sub 下年_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Me.下年.SpecialEffect = 3 Me.年份.Caption = Me.年份.Caption + 1 Call Datejc End Sub Public Sub Datejc() ' On Error Resume Next Dim Y As Integer Dim yf As String Dim i As Integer Dim X As Integer Dim kd As Date Dim sd As Date Dim td As Date Dim rl As Integer For Y = 1 To 12 yf = Mid("ABCDEFGHIJKL", Y, 1) kd = DateSerial(Me.年份.Caption, Y, 1) X = Format(kd, "w") If X = 1 Then X = 8 'If X = 2 Then X = 9 sd = DateSerial(Me.年份.Caption, Y + 1, 0) Me.Holidays.Caption = DCount("HolidayType", "tblHolidays", "year(HolidayDate)=" & Me.年份.Caption) Me.WorkDays.Caption = DateSerial(Me.年份.Caption, 12, 31) - DateSerial(Me.年份.Caption, 1, 1) + 1 _ - DCount("HolidayType", "tblHolidays", "year(HolidayDate)=" & Me.年份.Caption) For i = 1 To 42 td = kd - X + i + 1 With Me.Controls(yf & i) .Caption = Day(td) .ForeColor = RGB(0, 0, 0) If i <= X - 2 Or i > Day(sd) + X - 2 Then '非本月日期 .BackColor = 14803425 .ForeColor = 14803425 Else '是本月日期 'Me.Controls(yf & i).BackColor = 16777215 .OnMouseMove = "=DateMove('" & .Name & "')" ' .OnMouseDown = "=JJRax('" & .Name & "')" ' .OnMouseUp = "=JJRsf('" & .Name & "')" .OnClick = "=AllClick('" & .Name & "')" .OnDblClick = "=AllDblClick('" & .Name & "')" rl = Nz(DLookup("HolidayType", "tblHolidays", "HolidayDate=#" & td & "#")) 'If Format(td, "w") = 1 Or Format(td, "w") = 7 Then 'Me.Controls(yf & i).BackColor = 13816575 'End If If rl = 3 Then '節日 .BackColor = RGB(167, 218, 78) '16744703 ElseIf rl = 2 Then '假日 .BackColor = RGB(173, 192, 217) Else '上班日 .BackColor = 16777215 End If If Nz(DLookup("NotesTips", "tblHolidays", "HolidayDate=#" & td & "#")) <> 0 Then If Nz(DLookup("PIC1", "tblHolidays", "HolidayDate=#" & td & "#")) = 0 Then .ForeColor = RGB(255, 0, 0) Else .ForeColor = RGB(0, 0, 255) End If .FontWeight = 700 Else .ForeColor = RGB(0, 0, 0) .FontWeight = 400 End If End If If td = Date And .ForeColor <> 14803425 Then .BackColor = RGB(0, 255, 0) End With Next Next End Sub Public Function JJRax(an As String) Me.Controls(an).SpecialEffect = 2 End Function Public Function JJRsf(an As String) Me.Controls(an).SpecialEffect = 3 End Function Public Function DateMove(an As String) Dim RQ As Date Dim GL As String Dim NL As String Dim XQ As String Dim ZS As String If Me.Controls(an).BackColor = 14803425 Then Me.lblTip.Caption = " " Else GL = Me.年份.Caption & "年" & InStr("ABCDEFGHIJKL", Left(Me.Controls(an).Name, 1)) & "月" & Me.Controls(an).Caption & "日" RQ = CDate(Me.年份.Caption & "-" & InStr("ABCDEFGHIJKL", Left(Me.Controls(an).Name, 1)) & "-" & Me.Controls(an).Caption) NL = GetYLDate(RQ) XQ = WeekdayName(Weekday(RQ)) ZS = "第" & DatePart("ww", RQ, 2) & "周" Me.lblTip.Caption = GL & " " & XQ & " " & NL & " " & ZS Me.DateTips.Caption = Nz(DLookup("NotesTips", "tblHolidays", "HolidayDate=#" & RQ & "#"), Nz(DLookup("HolidayName", "tblHolidays", "HolidayDate=#" & RQ & "#"), "")) Me.DateTips01.Caption = Nz(DLookup("NotesTips", "tblHolidays", "HolidayDate=#" & RQ & "#"), Nz(DLookup("HolidayName", "tblHolidays", "HolidayDate=#" & RQ & "#"), "")) Me.TLocked.Left = Me.Controls(an).Left Me.TLocked.Top = Me.Controls(an).Top Me.TLocked.Visible = True End If End Function Public Function AllDblClick(an As String) Dim RQ As Date RQ = CDate(Me.年份.Caption & "-" & InStr("ABCDEFGHIJKL", Left(Me.Controls(an).Name, 1)) & "-" & Me.Controls(an).Caption) If Nz(DLookup("HolidayDate", "tblHolidays", "HolidayDate=#" & RQ & "#")) = 0 Then DoCmd.OpenForm "WorkNotesTipsEdit", , , , acFormAdd Else DoCmd.OpenForm "WorkNotesTipsEdit", , , "HolidayDate=#" & RQ & "#" End If End Function Public Function AllClick(an As String) Dim RQ As Date RQ = CDate(Me.年份.Caption & "-" & InStr("ABCDEFGHIJKL", Left(Me.Controls(an).Name, 1)) & "-" & Me.Controls(an).Caption) If Nz(DLookup("HolidayDate", "tblHolidays", "HolidayDate=#" & RQ & "#")) = 0 Then Exit Function Else DoCmd.OpenForm "WorkNotesTipsEdit", , , "HolidayDate=#" & RQ & "#" End If End Function
搜尋相關Tags的文章:
[ 當資料庫分割前後後 ] , [ 在執行時非常慢 ] , [ 沒有分割是不會的 ] , [ 請問各位老師 ] , [ 有沒有辦法解決? ] ,
本篇文章發表於2022-04-16 09:57 |
1樓
最有價值解答
tungta ![]() ![]() |
Access分割之後資料檔與執行檔不在一起,當然會變慢,若不是在同一部電腦,而是透過區域網路連結會更慢,這是由於Access在設計過程中逐漸累積許多垃圾所導致,開兩個空白Access,將資料檔與執行檔分別匯入取代舊檔,就能消除垃圾,連結的速度就會快很多,但是不可能跟未分割時一樣快
本篇文章回覆於2022-05-04 20:56
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔-- |
2樓 |
我是將會異動的資料才移置後端資料庫,固定資料保留在前端,每次關閉表單前會壓縮資料庫。
本篇文章回覆於2022-05-19 10:30
== 簽名檔 ==
--未登入的會員無法查看對方簽名檔-- |
回覆 |
如要回應,請先登入. |