maidinhdan > 06-08-15, 05:57 PM
Trích dẫn:'---------------------------------------------------------------------------------------
' Ten ham : cmdChonngay_Click
' Tac gia : Admin
' Ngay viet : 8/6/2015
' Dien giai : De y 2 cho de chinh sua khi ap dung
' ---Thu 1: Me.cmdChonngay.Top or Left la nut nhan cua ta
' ---Thu 2: Me.FormHeader.Height - Neu tren form khong chon FormHeader thi xoa (+ Me.FormHeader.Height)
' ---Thu 3: Me.txtNgaybatdau day la o textbox ma chung ta muon ngay nhay vao o nay.
'---------------------------------------------------------------------------------------
Private Sub cmdChonngay_Click()
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
ToadoForm Me, x1, y1, x2, y2
x1 = ConvertRes(x1, False, False) + Me.cmdChonngay.Left + 230
y1 = ConvertRes(y1, True, False) + Me.cmdChonngay.Top + Me.FormHeader.Height + 100
DoCmd.OpenForm "frmCalendar", , , , , acDialog, x1 & "," & y1
If gDate <> 0 Then
Me.txtNgaybatdau = gDate
End If
End Sub
Trích dẫn:Private Sub cmdChonngay2_Click()
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long
ToadoForm Me, x1, y1, x2, y2
x1 = ConvertRes(x1, False, False) + Me.cmdChonngay2.Left + 230
y1 = ConvertRes(y1, True, False) + Me.cmdChonngay2.Top + Me.FormHeader.Height + 100
DoCmd.OpenForm "frmCalendar", , , , , acDialog, x1 & "," & y1
If gDate <> 0 Then
Me.txtngay2 = gDate
End If
End Sub
Public Sub ToadoForm(frm As Form, ByRef x1 As Long, ByRef y1 As Long, ByRef x2 As Long, ByRef y2 As Long)
Dim rct As FormCoords
GetWindowRect frm.Hwnd, rct
x1 = rct.lngX1 'left edge
y1 = rct.lngY1 'top edge
x2 = rct.lngX2 'right edge (not used)
y2 = rct.lngY2 'bottom edge (not used)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err_Handler
'Purpose: Ma hoa cac phim tat tren ban phim
With Me.txtDate
Select Case KeyCode
Case vbKeyLeft '1 day left or right.
.Value = .Value - 1
KeyCode = 0
Call ShowCal
Case vbKeyRight
.Value = .Value + 1
KeyCode = 0
Call ShowCal
Case vbKeyUp 'up or down cua mot tuan
.Value = .Value - 7
KeyCode = 0
Call ShowCal
Case vbKeyDown
.Value = .Value + 7
KeyCode = 0
Call ShowCal
Case vbKeyHome 'Home/End = first/last cua Thang
.Value = .Value - Day(.Value) + 1
KeyCode = 0
Call ShowCal
Case vbKeyEnd
.Value = DateSerial(Year(.Value), Month(.Value) + 1, 0)
KeyCode = 0
Call ShowCal
Case vbKeyPageUp 'PgUp/PgDn = previous/next cua Thang
.Value = DateAdd("m", -1, .Value)
KeyCode = 0
Call ShowCal
Case vbKeyPageDown
.Value = DateAdd("m", 1, .Value)
KeyCode = 0
Call ShowCal
Case vbKeyT, vbKeyT + 32 'T or t = Hom nay
.Value = Date
KeyCode = 0
Call ShowCal
End Select
End With
Exit_Handler:
Exit Sub
Err_Handler:
Resume Exit_Handler
End Sub
rainkv > 06-08-15, 06:13 PM
maidinhdan > 06-08-15, 09:07 PM
(06-08-15, 06:13 PM)rainkv Đã viết: Maidinhdan coi lại Demo xem hay sao mà mình chọn qua ngày thứ 2 nó báo lỗi chỗ này:
'API Declarations
Declare Sub GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As FormCoords)
Declare Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal Hwnd As Long, ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare PtrSafe Sub GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As FormCoords)
Declare PtrSafe Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal Hwnd As Long, ByVal hdc As Long) As Long
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
rainkv > 06-08-15, 10:20 PM
(06-08-15, 09:07 PM)maidinhdan Đã viết:Mình chạy trên win 10 64bit, office 2013. Mình mới chạy thử thui vì thấy hay chứ chưa dùng đến. Để cthay code bạn đưa xem thử có cdc ko.(06-08-15, 06:13 PM)rainkv Đã viết: Maidinhdan coi lại Demo xem hay sao mà mình chọn qua ngày thứ 2 nó báo lỗi chỗ này:
'API Declarations
Declare Sub GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As FormCoords)
Declare Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal Hwnd As Long, ByVal hdc As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Máy mình chạy bình thường ( Trên WinXp 32bit, Win8 64bit). Do mình thiết kế dùng cho Office 2003 hệ 32bit. Chưa test trên 2007 hoặc hơn.
Nếu vậy bạn sửa cả 4 đoạn trên thành như sau, để có thể sử dụng trên hệ 64bit.
Mã PHP:Declare PtrSafe Sub GetWindowRect Lib "user32" (ByVal Hwnd As Long, lpRect As FormCoords)
Declare PtrSafe Function GetDC Lib "user32" (ByVal Hwnd As Long) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal Hwnd As Long, ByVal hdc As Long) As Long
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Nếu không được, thì cài lại Win bản quyền nhé,
tranthanhan1962 > 07-08-15, 02:35 AM
maidinhdan > 07-08-15, 10:56 AM
tranthanhan1962 > 07-08-15, 01:32 PM
zinzin8x > 25-06-16, 12:44 AM
quocbinh77dilang@gmail.com > 09-05-17, 05:27 PM