ongke0711 > 11-01-19, 07:46 PM
Option Explicit
Private mvarButtons(11) As String
Private WithEvents mctlForm As Access.Form
Private mlblLabelToUpdate As Access.Label
Private mlngTotalRecords As Long
Private mrstFormRecordset As DAO.Recordset
Private mstrSQL As String
Private mvarBookmark As Variant
Private mctlFocusSave As Control
Private mblnAddMode As Boolean
Private mblnEditMode As Boolean
Private mblnDisplayRecordPos As Boolean
Private mstrSourceTable As String
Private mstrPrimaryKey As String
Private Const mconBGAddNew = 13691373 'RGB(237, 233, 208)
Private Const mconBGSave = 16777215
Private Sub Class_Initialize()
' Muc dich: Gán các nút lenh (Navigation buttons) vào Array de goi trong hàm "processCMD"
' Dùng de enabled/disable các nút lenh tuy theo.
' Chú ý: Ten các nut lenh trong Form phai dong bo voi code trong class này.Vd: "btnFirst".
' So luong các nut lenh cung phai nhat quán.
On Error GoTo HandleError
mvarButtons(0) = "btnFirst"
mvarButtons(1) = "btnPrevious"
mvarButtons(2) = "btnNext"
mvarButtons(3) = "btnLast"
mvarButtons(4) = "btnAdd"
mvarButtons(5) = "btnEdit"
mvarButtons(6) = "btnSave"
mvarButtons(7) = "btnDelete"
mvarButtons(8) = "btnUndo"
mvarButtons(9) = "btnFind"
mvarButtons(10) = "btnExit"
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Class_Initialize", "clsDataEntry")
End Sub
Private Sub Class_Terminate()
On Error GoTo HandleError
If Not mrstFormRecordset.EOF Then mrstFormRecordset.Close
Set mrstFormRecordset = Nothing
Set mctlFocusSave = Nothing
Set mctlForm = Nothing
Set mlblLabelToUpdate = Nothing
Erase mvarButtons
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Class_Terminate", "clsDataEntry")
End Sub
Private Sub InitialiseData()
' Lay du lieu va hien thi len form
'
On Error GoTo HandleError
Dim db As DAO.Database
Set db = CurrentDb
Set mrstFormRecordset = db.OpenRecordset(mstrSQL)
With mrstFormRecordset
If .RecordCount > 0 Then
If .EOF Then
mlngTotalRecords = 0
Else
.MoveLast
mlngTotalRecords = .RecordCount
.MoveFirst
mvarBookmark = .Bookmark 'Luu vi tri
Call DisplayData
End If
End If
End With
Call ToggleControls(True)
Call UpdateButtonsState
If mlngTotalRecords = 0 Then
Call UpdateLabel("0 / 0")
Else
Call UpdateLabel("1 / " & mlngTotalRecords)
End If
Set db = Nothing
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "InitialiseData", "DataEntryOne")
End Sub
Private Function KeyAutoIncrement(strField) As Boolean
' Tra ve gia tri True neu Primary Key là AutoNumber.
' Dung de thiet lap cac thuoc tinh riêng cho Field này trong Form.Vd: Enabled:No, Background...
On Error GoTo HandleError
If (mrstFormRecordset.Fields(strField).Attributes And dbAutoIncrField) Then
KeyAutoIncrement = True
Else
KeyAutoIncrement = False
End If
Exit Function
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "KeyAutoIncrement", "clsDataEntry")
End Function
Private Sub ToggleControls(blnVal As Boolean)
' Muc dich: Locked/ Unlocked các textbox nhap lieu
On Error GoTo HandleError
Dim fld As Field
Dim ctl As Control
Dim strControlName As Variant
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
If ctl.Tag = "yes" Then 'Phai thiet lap Tag: Yes cho các textbox dùng nhap lieu.
'Bo qua Field Primary key neu nó là Autonumber
If Not KeyAutoIncrement(fld.Name) Then
ctl.Locked = blnVal
End If
End If
Next fld
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "ToggleControls", "clsDataEntry")
End Sub
Public Property Set LabelToUpdate(ByVal lblVal As Label)
' Khai bao doi tuong label nào dùng de hien thi thong tin record navigation
On Error GoTo HandleError
Set mlblLabelToUpdate = lblVal
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Set LabelToUpdate", "clsDataEntry")
End Property
Private Sub UpdateLabel(strMsg As String)
' Cap nhat noi dung lable hien trang record
On Error GoTo HandleError
If mblnDisplayRecordPos Then
mlblLabelToUpdate.Caption = strMsg
End If
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "UpdateLabel", "clsDataEntry")
End Sub
Public Sub ProcessCMD(intIndex As Integer)
' Muc dich: Duoc goi cho moi nút lenh (Them, Sua, Xoa, tien, lùi...).
' indx: Tham so xác dinh nút nào duoc bam.
On Error GoTo HandleError
Select Case intIndex
Case 0 'First
mrstFormRecordset.MoveFirst
Call ProcessDisplay("1 / " & mlngTotalRecords)
Case 1 'Previous
With mrstFormRecordset
.MovePrevious
Call ProcessDisplay(.AbsolutePosition + 1 & " / " & mlngTotalRecords)
End With
Case 2 'Next
With mrstFormRecordset
.MoveNext
Call ProcessDisplay(.AbsolutePosition + 1 & " / " & mlngTotalRecords)
End With
Case 3 'Last
mrstFormRecordset.MoveLast
Call ProcessDisplay(mlngTotalRecords & " / " & mlngTotalRecords)
Case 4 'AddNew
Call ToggleControls(False) ' unlock tat ca textbox nhap lieu
Call FormatControls(mconBGAddNew) 'Dinh dang background textbox nhap lieu khi them moi
mblnAddMode = True
If mlngTotalRecords > 0 Then
'Luu vi tri record truoc khi AddNew. Neu Undo thi se tra vè vi tri cu.
mvarBookmark = mrstFormRecordset.Bookmark
Else
mvarBookmark = ""
End If
Call UpdateLabel("Dòng m" & ChrW(7899) & "i")
Call UpdateButtonsState
Call ClearData
Case 5 'Edit
'.LockEdits = True ' Neu trong moi truong da nguoi dung (multi users) thì dùng .LockEdits de bay loi Edit
Call ToggleControls(False)
mblnEditMode = True
Call FormatControls(mconBGAddNew)
Call UpdateButtonsState
Case 6 'Save
Call ToggleControls(True)
If mblnAddMode Then
Call AddNewRecord
mlngTotalRecords = mlngTotalRecords + 1
Call UpdateLabel(mlngTotalRecords & " / " & mlngTotalRecords)
Else
If mblnEditMode Then
Call EditRecord
End If
End If
Call FormatControls(mconBGSave)
mblnAddMode = False
mblnEditMode = False
Call UpdateButtonsState
Case 7 'Delete
If MsgBoxUni("B" & ChrW(7841) & "n mu" & ChrW(7889) & "n xóa dòng này?", _
vbYesNo, "Xác nh" & ChrW(7853) & "n xóa dòng") = vbYes Then
Call DeleteRecord
Call UpdateButtonsState
End If
Case 8 'Undo
Call UndoEdit
Call UpdateButtonsState
'Case 9 'Find
'Thiet lap rieng frmFind tùy tung form
Case 10 'Exit
DoCmd.Close acForm, mctlForm.Name
End Select
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "ProcessCMD", "clsDataEntry")
End Sub
Public Sub GotoRecord(pkey As Variant)
' Muc dich: Di chuyen toi record chi dinh. (Standard Search)
' pkey: Primary key value
On Error GoTo HandleError
With mrstFormRecordset
.FindFirst mstrPrimaryKey & "=" & pkey
Call ProcessDisplay(.AbsolutePosition + 1 & " / " & mlngTotalRecords)
End With
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "GoToRecord", "clsDataEntry")
End Sub
Private Sub ProcessDisplay(strMsg As String)
On Error GoTo HandleError
Call DisplayData
Call UpdateLabel(strMsg)
Call UpdateButtonsState 'Phai setfocus vào control khac truoc khi en/disable
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "ProcessDisplay", "clsDataEntry")
End Sub
Private Sub UndoEdit()
' Dùng Unbound form nen chi can tra vè hien trang cu, chua luu du lieu vao table
On Error GoTo HandleError
Call ToggleControls(True)
Call FormatControls(mconBGSave)
If mlngTotalRecords > 0 Then
If mblnAddMode Then ' Tra ve vi tri record cu truoc khi AddNew
mrstFormRecordset.Bookmark = mvarBookmark
Call UpdateLabel(mrstFormRecordset.AbsolutePosition + 1 & " / " & mlngTotalRecords)
End If
Call DisplayData
Else
Call ClearData
Call UpdateLabel("0 / 0")
End If
mblnAddMode = False
mblnEditMode = False
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "UndoEdit", "clsDataEntry")
End Sub
Private Sub AddNewRecord()
' Luu record moi vao table
On Error GoTo HandleError
Dim ctl As Control
Dim fld As DAO.Field
Dim varField As Variant
Dim indx As Integer
With mrstFormRecordset
.AddNew
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
If ctl.Tag = "yes" Then 'Chi cap nhat du lieu tu textbox có Tag=yes
varField = ctl.Value
If KeyAutoIncrement(fld.Name) Then
mctlForm.Controls(fld.Name) = .Fields(fld.Name)
Else
'Chuyen textbox co zero length thành Null neu can
mrstFormRecordset(fld.Name) = IIf(varField = "", Null, varField)
End If
End If
Next fld
.Update
.MoveLast 'Di chuyen den record vua moi them
End With
RequerySubform
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "AddNewRecord", "clsDataEntry")
End Sub
Private Sub EditRecord()
On Error GoTo HandleError
Dim ctl As Control
Dim fld As Field
Dim varField As Variant
With mrstFormRecordset
.Edit
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
If ctl.Tag = "yes" Then
If Not KeyAutoIncrement(fld.Name) Then
varField = TriM$(Nz(ctl.Value))
varField = IIf(Len(varField) = 0, Null, varField)
mrstFormRecordset(fld.Name) = varField
End If
End If
Next fld
.Update
End With
RequerySubform
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "EditRecord", "clsDataEntry")
End Sub
Private Sub DeleteRecord()
' Dùng phuong thuc .Delete cua DAO Recordset.
' Chi dùng duoc cho Recordset dang Dynaset, khong duoc cho Snapshot
' DAO Recordset tu dong Delete ma khong thong bao. Nó khong tu dong di chuyen qua record tiep nên phai .MoveNext
On Error GoTo HandleError
Dim lngAbsolutePosition As Long
With mrstFormRecordset
lngAbsolutePosition = .AbsolutePosition
.Delete
mlngTotalRecords = mlngTotalRecords - 1
If mlngTotalRecords = 0 Then 'Vua Xoa record cuôi cùng cua recordset
Call ClearData
Call UpdateLabel("0 / 0")
Else
If lngAbsolutePosition = mlngTotalRecords Then 'Là dong cuoi cùng
.MovePrevious
Else
lngAbsolutePosition = lngAbsolutePosition + 1
.MoveNext
End If
Call DisplayData
Call UpdateLabel(lngAbsolutePosition & " / " & mlngTotalRecords)
End If
End With
Call RequerySubform
Exit Sub
HandleError:
If Err.Number = 3200 Then
MsgBoxUni "B" & ChrW(7841) & "n không th" & ChrW(7875) & " xóa dòng này!" & vbCrLf & ChrW(272) & "ã có d" & ChrW(7919) & " li" & ChrW(7879) & "u phát sinh liên quan.", vbExclamation, "C" & ChrW(7843) & "nh báo."
Else
Call basHandleError.LogError(Err.Number, Err.Description, "", "DeleteRecord", "clsDataEntry")
End If
End Sub
Private Sub DisplayData()
' Hien thi Record hien tai len Form.
On Error GoTo HandleError
Dim ctl As Control
Dim fld As Field
Dim indx As Integer
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
If ctl.Tag = "yes" Then
If mrstFormRecordset(fld.Name).Type = dbDate Then
ctl.Value = Format(mrstFormRecordset(fld.Name), "dd/mm/yyyy")
Else
ctl.Value = mrstFormRecordset(fld.Name)
End If
End If
Next fld
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "DisplayData", "clsDataEntry")
End Sub
Private Sub ClearData()
' Xoa noi dung textbox
On Error GoTo HandleError
Dim ctl As Control
Dim fld As Field
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
If ctl.Tag = "yes" Then
ctl.Value = ""
End If
Next fld
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "ClearData", "clsDataEntry")
End Sub
Private Sub RequerySubform()
Dim ctl As Control
For Each ctl In mctlForm.Controls
If ctl.ControlType = acSubform Then
ctl.Requery
End If
Next ctl
End Sub
Private Sub FormatControls(lngColor As Long)
' Dinh dang background cua các textnhap lieu: màu vàng khi thêm mói, tra vè nhu cu khi Save.
On Error GoTo HandleError
Dim ctl As Control
Dim fld As Field
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
With ctl
If .Tag = "yes" Then
' Bo qua Field Autonumber
If Not KeyAutoIncrement(fld.Name) Then
.BackColor = lngColor
End If
End If
End With
Next fld
DoEvents
FormatControls_Exit:
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "FormatControls", "clsDataEntry")
Resume FormatControls_Exit
End Sub
Private Sub UpdateButtonsState()
' Muc dich: Enabled/ Disabled các nút lenh (Thêm, Sua, Xóa...)
' 1=Enabled; 0=Disabled.
' Gán hàng loat (11 nút lenh) dua theo chuoi 11 ký tu 0 1 (strButtonState).
On Error GoTo HandleError
mctlFocusSave.SetFocus
If mblnAddMode Then 'Thêm record moi
Call EnableDisableButtons("00000010100") 'Vd: Enable nút Sua, Huy (index 6,8 =1)
ElseIf mblnEditMode Then 'Sua record
Call EnableDisableButtons("00000010100")
Else 'Hien trang binh thuong
With mrstFormRecordset
If (mlngTotalRecords = 0) Then
Call EnableDisableButtons("00001000001") 'Enable nút Them, Dóng
ElseIf mlngTotalRecords = 1 Then
Call EnableDisableButtons("00001101001") 'Them, Sua, Xoa
ElseIf .AbsolutePosition = 0 Then 'dang o record dau tien
Call EnableDisableButtons("00111101011")
ElseIf (.AbsolutePosition = mlngTotalRecords - 1) Then ' dang o record cuoi
Call EnableDisableButtons("11001101011")
Else
Call EnableDisableButtons("11111101011") ' dang o các record giua
End If
End With
End If
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "UpdateButtonsState", "clsDataEntry")
End Sub
Private Sub EnableDisableButtons(strButtonState As String)
' Muc dich: Enable/ Disable hàng loat Array (11 nút lenh) dua theo chuoi 11 ký tu (0, 1) (strButtonState).
' 1=enabled; 0=disabled
On Error GoTo HandleError
Dim intindx As Integer
Dim intButtonLength As Integer
Dim strEnabled As String
strButtonState = TriM$(strButtonState)
intButtonLength = Len(strButtonState)
For intindx = 1 To intButtonLength
strEnabled = Mid$(strButtonState, intindx, 1)
With mctlForm.Controls(mvarButtons(intindx - 1))
If .Enabled <> (strEnabled = "1") Then
.Enabled = (strEnabled = "1")
End If
End With
Next intindx
DoEvents
EnableDisableButtons_Exit:
On Error Resume Next
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "EnableDisableButtons", "clsDataEntry")
Resume EnableDisableButtons_Exit
End Sub
Public Property Let FormRecordsetSQL(ByVal sSQL As String)
On Error GoTo HandleError
mstrSQL = sSQL ' Truyen cau lenh SQL làm Form Recordset
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Let FormRecordsetSQL", "clsDataEntry")
End Property
Public Property Set FocusControl(ByVal cValue As Control)
' Khi thiet lap Disable control bat buoc phai focus vào 1 control khác nó.
On Error GoTo HandleError
Set mctlFocusSave = cValue
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Set FocusControl", "clsDataEntry")
End Property
Public Property Let SourceTable(ByVal sSourceTableName As String)
' Gan thuoc tinh nay de du phong. Chua dùng den trong class này.
On Error GoTo HandleError
mstrSourceTable = sSourceTableName
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Let SourceTable", "clsDataEntry")
End Property
Public Property Get SourceTableName()
On Error GoTo HandleError
SourceTableName = mstrSourceTable
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Get SourceTable", "clsDataEntry")
End Property
Public Property Let DisplayRecordPosition(ByVal blnShowHide As Boolean)
On Error GoTo HandleError
mblnDisplayRecordPos = blnShowHide
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Let DisplayRecordPosition", "clsDataEntry")
End Property
Public Property Let PrimaryKey(ByVal sPKFieldName As String)
On Error GoTo HandleError
mstrPrimaryKey = sPKFieldName
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Let PrimaryKey", "clsDataEntry")
End Property
Public Property Set FormCtl(ByVal frmVal As Access.Form)
'frmVal: Gan Form chua cac NavButton xu ly cho class
On Error GoTo HandleError
Set mctlForm = frmVal
Call InitialiseData
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Set FormCtl", "clsDataEntry")
End Property
minhkhai > 11-08-19, 06:37 PM
(11-01-19, 07:46 PM)ongke0711 Đã viết:File rất hay, có chút buồn xíu là nó chỉ chạy trên Access 32bit.
Trước đây cũng đã có các bài viết chia sẻ code các nút lệnh Tiến - Lùi - Sửa - Xoá của bác tranthanhan1962,
XuanThanh v.v.. và viết trong Standard module sử dụng rất hiệu quả.
Link tham khảo:
http://thuthuataccess.com/forum/post-395...l#pid39513
http://thuthuataccess.com/forum/thread-8467.html
Lần này tôi chia sẻ với các bạn một Form (Unbound) nhập liệu với các nút lệnh cơ bản nhất và đặc biệt là viết trong Class module.
Tại sao dùng Class module:
- Cũng giống như standard module là bạn có thể sử dụng (gọi) lại ở bất kỳ form nào mà không cần phải viết lại cho từng form.
- Riêng với Class module thì các hàm, thủ tục chỉ khởi chạy khi Form gọi nó và sẽ thoát và giải phóng khỏi bộ nhớ khi Form đóng lại. Do đó ứng dụng chạy sẽ chiếm ít tài nguyên hệ thống hơn là các hàm, thủ tục lưu trong standard module. Khi ứng dụng chạy thì toàn bộ các hàm trong standard module sẽ tự động load hết lên memory.
- Dùng Class thì số dòng code viết cho từng Form sẽ được giảm đi rất nhiều.
- Đối với các Form với nhiều Control xử lý phức tạp và lặp đi lặp lại nhiều thì dùng Class sẽ hiệu quả hơn (như ví dụ trong bài post trước của tôi về Form với các nút Sort và Filter theo từng Field).
- Thực ra không phải trường hợp nào bạn cũng dùng class. Có những sự kiện đơn giản chỉ cần dùng form module hoặc standard module là đủ xài rồi. Nếu dùng class thì hơi quá, giống như là dùng "Dao mổ bò để giết gà" vậy.
- Bạn có thể tham khảo thêm về Class module trong các link sau:
http://thuthuataccess.com/forum/thread-5297.html
http://www.kallal.ca/Articles/WhyClass.html
http://www.cpearson.com/excel/classes.aspx
Trở lại Form demo này. Tuy là demo cơ bản nhưng tôi nghĩ nó cũng khá đầy đủ cho một form nhập liệu để các bạn tham khảo.
- Form bao gồm 11 nút lệnh cơ bản: Thêm - Sửa - Xoá - Huỷ - Tìm kiếm - ...
- Xuất file sang Word (Pdf).
- Có form tìm kiếm theo tuỳ chọn Field.
- Bẫy các lỗi nhập liệu.
Qui định thiết kế trong Form:
- Các nút lệnh đặt tên có các ký tự đầu là "btn" -> button. Vd: btnAdd. Bạn không được thay đổi tên (name) các nút lênh vì có liên quan đến code gọi trong class. Nếu muốn đổi thì phải đổi đồng bộ luôn trong class.
- Các Textbox dùng để nhập liệu phải đặt thuộc tính Tag=Yes. Mục đích: để code xác định những textbox nào trên form để lấy dữ liệu cũng như gán dữ liệu cho nó. Các textbox này cũng đặt Name trùng với tên Field.
Code cho class module: đặt tên clsDataEntry
Mã PHP:Option Explicit
Private mvarButtons(11) As String
Private WithEvents mctlForm As Access.Form
Private mlblLabelToUpdate As Access.Label
Private mlngTotalRecords As Long
Private mrstFormRecordset As DAO.Recordset
Private mstrSQL As String
Private mvarBookmark As Variant
Private mctlFocusSave As Control
Private mblnAddMode As Boolean
Private mblnEditMode As Boolean
Private mblnDisplayRecordPos As Boolean
Private mstrSourceTable As String
Private mstrPrimaryKey As String
Private Const mconBGAddNew = 13691373 'RGB(237, 233, 208)
Private Const mconBGSave = 16777215
Private Sub Class_Initialize()
' Muc dich: Gán các nút lenh (Navigation buttons) vào Array de goi trong hàm "processCMD"
' Dùng de enabled/disable các nút lenh tuy theo.
' Chú ý: Ten các nut lenh trong Form phai dong bo voi code trong class này.Vd: "btnFirst".
' So luong các nut lenh cung phai nhat quán.
On Error GoTo HandleError
mvarButtons(0) = "btnFirst"
mvarButtons(1) = "btnPrevious"
mvarButtons(2) = "btnNext"
mvarButtons(3) = "btnLast"
mvarButtons(4) = "btnAdd"
mvarButtons(5) = "btnEdit"
mvarButtons(6) = "btnSave"
mvarButtons(7) = "btnDelete"
mvarButtons(8) = "btnUndo"
mvarButtons(9) = "btnFind"
mvarButtons(10) = "btnExit"
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Class_Initialize", "clsDataEntry")
End Sub
Private Sub Class_Terminate()
On Error GoTo HandleError
If Not mrstFormRecordset.EOF Then mrstFormRecordset.Close
Set mrstFormRecordset = Nothing
Set mctlFocusSave = Nothing
Set mctlForm = Nothing
Set mlblLabelToUpdate = Nothing
Erase mvarButtons
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Class_Terminate", "clsDataEntry")
End Sub
Private Sub InitialiseData()
' Lay du lieu va hien thi len form
'
On Error GoTo HandleError
Dim db As DAO.Database
Set db = CurrentDb
Set mrstFormRecordset = db.OpenRecordset(mstrSQL)
With mrstFormRecordset
If .RecordCount > 0 Then
If .EOF Then
mlngTotalRecords = 0
Else
.MoveLast
mlngTotalRecords = .RecordCount
.MoveFirst
mvarBookmark = .Bookmark 'Luu vi tri
Call DisplayData
End If
End If
End With
Call ToggleControls(True)
Call UpdateButtonsState
If mlngTotalRecords = 0 Then
Call UpdateLabel("0 / 0")
Else
Call UpdateLabel("1 / " & mlngTotalRecords)
End If
Set db = Nothing
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "InitialiseData", "DataEntryOne")
End Sub
Private Function KeyAutoIncrement(strField) As Boolean
' Tra ve gia tri True neu Primary Key là AutoNumber.
' Dung de thiet lap cac thuoc tinh riêng cho Field này trong Form.Vd: Enabled:No, Background...
On Error GoTo HandleError
If (mrstFormRecordset.Fields(strField).Attributes And dbAutoIncrField) Then
KeyAutoIncrement = True
Else
KeyAutoIncrement = False
End If
Exit Function
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "KeyAutoIncrement", "clsDataEntry")
End Function
Private Sub ToggleControls(blnVal As Boolean)
' Muc dich: Locked/ Unlocked các textbox nhap lieu
On Error GoTo HandleError
Dim fld As Field
Dim ctl As Control
Dim strControlName As Variant
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
If ctl.Tag = "yes" Then 'Phai thiet lap Tag: Yes cho các textbox dùng nhap lieu.
'Bo qua Field Primary key neu nó là Autonumber
If Not KeyAutoIncrement(fld.Name) Then
ctl.Locked = blnVal
End If
End If
Next fld
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "ToggleControls", "clsDataEntry")
End Sub
Public Property Set LabelToUpdate(ByVal lblVal As Label)
' Khai bao doi tuong label nào dùng de hien thi thong tin record navigation
On Error GoTo HandleError
Set mlblLabelToUpdate = lblVal
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Set LabelToUpdate", "clsDataEntry")
End Property
Private Sub UpdateLabel(strMsg As String)
' Cap nhat noi dung lable hien trang record
On Error GoTo HandleError
If mblnDisplayRecordPos Then
mlblLabelToUpdate.Caption = strMsg
End If
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "UpdateLabel", "clsDataEntry")
End Sub
Public Sub ProcessCMD(intIndex As Integer)
' Muc dich: Duoc goi cho moi nút lenh (Them, Sua, Xoa, tien, lùi...).
' indx: Tham so xác dinh nút nào duoc bam.
On Error GoTo HandleError
Select Case intIndex
Case 0 'First
mrstFormRecordset.MoveFirst
Call ProcessDisplay("1 / " & mlngTotalRecords)
Case 1 'Previous
With mrstFormRecordset
.MovePrevious
Call ProcessDisplay(.AbsolutePosition + 1 & " / " & mlngTotalRecords)
End With
Case 2 'Next
With mrstFormRecordset
.MoveNext
Call ProcessDisplay(.AbsolutePosition + 1 & " / " & mlngTotalRecords)
End With
Case 3 'Last
mrstFormRecordset.MoveLast
Call ProcessDisplay(mlngTotalRecords & " / " & mlngTotalRecords)
Case 4 'AddNew
Call ToggleControls(False) ' unlock tat ca textbox nhap lieu
Call FormatControls(mconBGAddNew) 'Dinh dang background textbox nhap lieu khi them moi
mblnAddMode = True
If mlngTotalRecords > 0 Then
'Luu vi tri record truoc khi AddNew. Neu Undo thi se tra vè vi tri cu.
mvarBookmark = mrstFormRecordset.Bookmark
Else
mvarBookmark = ""
End If
Call UpdateLabel("Dòng m" & ChrW(7899) & "i")
Call UpdateButtonsState
Call ClearData
Case 5 'Edit
'.LockEdits = True ' Neu trong moi truong da nguoi dung (multi users) thì dùng .LockEdits de bay loi Edit
Call ToggleControls(False)
mblnEditMode = True
Call FormatControls(mconBGAddNew)
Call UpdateButtonsState
Case 6 'Save
Call ToggleControls(True)
If mblnAddMode Then
Call AddNewRecord
mlngTotalRecords = mlngTotalRecords + 1
Call UpdateLabel(mlngTotalRecords & " / " & mlngTotalRecords)
Else
If mblnEditMode Then
Call EditRecord
End If
End If
Call FormatControls(mconBGSave)
mblnAddMode = False
mblnEditMode = False
Call UpdateButtonsState
Case 7 'Delete
If MsgBoxUni("B" & ChrW(7841) & "n mu" & ChrW(7889) & "n xóa dòng này?", _
vbYesNo, "Xác nh" & ChrW(7853) & "n xóa dòng") = vbYes Then
Call DeleteRecord
Call UpdateButtonsState
End If
Case 8 'Undo
Call UndoEdit
Call UpdateButtonsState
'Case 9 'Find
'Thiet lap rieng frmFind tùy tung form
Case 10 'Exit
DoCmd.Close acForm, mctlForm.Name
End Select
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "ProcessCMD", "clsDataEntry")
End Sub
Public Sub GotoRecord(pkey As Variant)
' Muc dich: Di chuyen toi record chi dinh. (Standard Search)
' pkey: Primary key value
On Error GoTo HandleError
With mrstFormRecordset
.FindFirst mstrPrimaryKey & "=" & pkey
Call ProcessDisplay(.AbsolutePosition + 1 & " / " & mlngTotalRecords)
End With
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "GoToRecord", "clsDataEntry")
End Sub
Private Sub ProcessDisplay(strMsg As String)
On Error GoTo HandleError
Call DisplayData
Call UpdateLabel(strMsg)
Call UpdateButtonsState 'Phai setfocus vào control khac truoc khi en/disable
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "ProcessDisplay", "clsDataEntry")
End Sub
Private Sub UndoEdit()
' Dùng Unbound form nen chi can tra vè hien trang cu, chua luu du lieu vao table
On Error GoTo HandleError
Call ToggleControls(True)
Call FormatControls(mconBGSave)
If mlngTotalRecords > 0 Then
If mblnAddMode Then ' Tra ve vi tri record cu truoc khi AddNew
mrstFormRecordset.Bookmark = mvarBookmark
Call UpdateLabel(mrstFormRecordset.AbsolutePosition + 1 & " / " & mlngTotalRecords)
End If
Call DisplayData
Else
Call ClearData
Call UpdateLabel("0 / 0")
End If
mblnAddMode = False
mblnEditMode = False
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "UndoEdit", "clsDataEntry")
End Sub
Private Sub AddNewRecord()
' Luu record moi vao table
On Error GoTo HandleError
Dim ctl As Control
Dim fld As DAO.Field
Dim varField As Variant
Dim indx As Integer
With mrstFormRecordset
.AddNew
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
If ctl.Tag = "yes" Then 'Chi cap nhat du lieu tu textbox có Tag=yes
varField = ctl.Value
If KeyAutoIncrement(fld.Name) Then
mctlForm.Controls(fld.Name) = .Fields(fld.Name)
Else
'Chuyen textbox co zero length thành Null neu can
mrstFormRecordset(fld.Name) = IIf(varField = "", Null, varField)
End If
End If
Next fld
.Update
.MoveLast 'Di chuyen den record vua moi them
End With
RequerySubform
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "AddNewRecord", "clsDataEntry")
End Sub
Private Sub EditRecord()
On Error GoTo HandleError
Dim ctl As Control
Dim fld As Field
Dim varField As Variant
With mrstFormRecordset
.Edit
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
If ctl.Tag = "yes" Then
If Not KeyAutoIncrement(fld.Name) Then
varField = TriM$(Nz(ctl.Value))
varField = IIf(Len(varField) = 0, Null, varField)
mrstFormRecordset(fld.Name) = varField
End If
End If
Next fld
.Update
End With
RequerySubform
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "EditRecord", "clsDataEntry")
End Sub
Private Sub DeleteRecord()
' Dùng phuong thuc .Delete cua DAO Recordset.
' Chi dùng duoc cho Recordset dang Dynaset, khong duoc cho Snapshot
' DAO Recordset tu dong Delete ma khong thong bao. Nó khong tu dong di chuyen qua record tiep nên phai .MoveNext
On Error GoTo HandleError
Dim lngAbsolutePosition As Long
With mrstFormRecordset
lngAbsolutePosition = .AbsolutePosition
.Delete
mlngTotalRecords = mlngTotalRecords - 1
If mlngTotalRecords = 0 Then 'Vua Xoa record cuôi cùng cua recordset
Call ClearData
Call UpdateLabel("0 / 0")
Else
If lngAbsolutePosition = mlngTotalRecords Then 'Là dong cuoi cùng
.MovePrevious
Else
lngAbsolutePosition = lngAbsolutePosition + 1
.MoveNext
End If
Call DisplayData
Call UpdateLabel(lngAbsolutePosition & " / " & mlngTotalRecords)
End If
End With
Call RequerySubform
Exit Sub
HandleError:
If Err.Number = 3200 Then
MsgBoxUni "B" & ChrW(7841) & "n không th" & ChrW(7875) & " xóa dòng này!" & vbCrLf & ChrW(272) & "ã có d" & ChrW(7919) & " li" & ChrW(7879) & "u phát sinh liên quan.", vbExclamation, "C" & ChrW(7843) & "nh báo."
Else
Call basHandleError.LogError(Err.Number, Err.Description, "", "DeleteRecord", "clsDataEntry")
End If
End Sub
Private Sub DisplayData()
' Hien thi Record hien tai len Form.
On Error GoTo HandleError
Dim ctl As Control
Dim fld As Field
Dim indx As Integer
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
If ctl.Tag = "yes" Then
If mrstFormRecordset(fld.Name).Type = dbDate Then
ctl.Value = Format(mrstFormRecordset(fld.Name), "dd/mm/yyyy")
Else
ctl.Value = mrstFormRecordset(fld.Name)
End If
End If
Next fld
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "DisplayData", "clsDataEntry")
End Sub
Private Sub ClearData()
' Xoa noi dung textbox
On Error GoTo HandleError
Dim ctl As Control
Dim fld As Field
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
If ctl.Tag = "yes" Then
ctl.Value = ""
End If
Next fld
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "ClearData", "clsDataEntry")
End Sub
Private Sub RequerySubform()
Dim ctl As Control
For Each ctl In mctlForm.Controls
If ctl.ControlType = acSubform Then
ctl.Requery
End If
Next ctl
End Sub
Private Sub FormatControls(lngColor As Long)
' Dinh dang background cua các textnhap lieu: màu vàng khi thêm mói, tra vè nhu cu khi Save.
On Error GoTo HandleError
Dim ctl As Control
Dim fld As Field
For Each fld In mrstFormRecordset.Fields
Set ctl = mctlForm.Controls(fld.Name)
With ctl
If .Tag = "yes" Then
' Bo qua Field Autonumber
If Not KeyAutoIncrement(fld.Name) Then
.BackColor = lngColor
End If
End If
End With
Next fld
DoEvents
FormatControls_Exit:
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "FormatControls", "clsDataEntry")
Resume FormatControls_Exit
End Sub
Private Sub UpdateButtonsState()
' Muc dich: Enabled/ Disabled các nút lenh (Thêm, Sua, Xóa...)
' 1=Enabled; 0=Disabled.
' Gán hàng loat (11 nút lenh) dua theo chuoi 11 ký tu 0 1 (strButtonState).
On Error GoTo HandleError
mctlFocusSave.SetFocus
If mblnAddMode Then 'Thêm record moi
Call EnableDisableButtons("00000010100") 'Vd: Enable nút Sua, Huy (index 6,8 =1)
ElseIf mblnEditMode Then 'Sua record
Call EnableDisableButtons("00000010100")
Else 'Hien trang binh thuong
With mrstFormRecordset
If (mlngTotalRecords = 0) Then
Call EnableDisableButtons("00001000001") 'Enable nút Them, Dóng
ElseIf mlngTotalRecords = 1 Then
Call EnableDisableButtons("00001101001") 'Them, Sua, Xoa
ElseIf .AbsolutePosition = 0 Then 'dang o record dau tien
Call EnableDisableButtons("00111101011")
ElseIf (.AbsolutePosition = mlngTotalRecords - 1) Then ' dang o record cuoi
Call EnableDisableButtons("11001101011")
Else
Call EnableDisableButtons("11111101011") ' dang o các record giua
End If
End With
End If
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "UpdateButtonsState", "clsDataEntry")
End Sub
Private Sub EnableDisableButtons(strButtonState As String)
' Muc dich: Enable/ Disable hàng loat Array (11 nút lenh) dua theo chuoi 11 ký tu (0, 1) (strButtonState).
' 1=enabled; 0=disabled
On Error GoTo HandleError
Dim intindx As Integer
Dim intButtonLength As Integer
Dim strEnabled As String
strButtonState = TriM$(strButtonState)
intButtonLength = Len(strButtonState)
For intindx = 1 To intButtonLength
strEnabled = Mid$(strButtonState, intindx, 1)
With mctlForm.Controls(mvarButtons(intindx - 1))
If .Enabled <> (strEnabled = "1") Then
.Enabled = (strEnabled = "1")
End If
End With
Next intindx
DoEvents
EnableDisableButtons_Exit:
On Error Resume Next
Exit Sub
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "EnableDisableButtons", "clsDataEntry")
Resume EnableDisableButtons_Exit
End Sub
Public Property Let FormRecordsetSQL(ByVal sSQL As String)
On Error GoTo HandleError
mstrSQL = sSQL ' Truyen cau lenh SQL làm Form Recordset
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Let FormRecordsetSQL", "clsDataEntry")
End Property
Public Property Set FocusControl(ByVal cValue As Control)
' Khi thiet lap Disable control bat buoc phai focus vào 1 control khác nó.
On Error GoTo HandleError
Set mctlFocusSave = cValue
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Set FocusControl", "clsDataEntry")
End Property
Public Property Let SourceTable(ByVal sSourceTableName As String)
' Gan thuoc tinh nay de du phong. Chua dùng den trong class này.
On Error GoTo HandleError
mstrSourceTable = sSourceTableName
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Let SourceTable", "clsDataEntry")
End Property
Public Property Get SourceTableName()
On Error GoTo HandleError
SourceTableName = mstrSourceTable
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Get SourceTable", "clsDataEntry")
End Property
Public Property Let DisplayRecordPosition(ByVal blnShowHide As Boolean)
On Error GoTo HandleError
mblnDisplayRecordPos = blnShowHide
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Let DisplayRecordPosition", "clsDataEntry")
End Property
Public Property Let PrimaryKey(ByVal sPKFieldName As String)
On Error GoTo HandleError
mstrPrimaryKey = sPKFieldName
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Let PrimaryKey", "clsDataEntry")
End Property
Public Property Set FormCtl(ByVal frmVal As Access.Form)
'frmVal: Gan Form chua cac NavButton xu ly cho class
On Error GoTo HandleError
Set mctlForm = frmVal
Call InitialiseData
Exit Property
HandleError:
Call basHandleError.LogError(Err.Number, Err.Description, "", "Property Set FormCtl", "clsDataEntry")
End Property
Code cho Form thì chỉ cần khởi tạo class ở sự kiện Form_Open là các nút lệnh có thể chạy: tham khảo thêm trong file.
Link demo: http://www
.mediafire.com/file/rzynj8tcera43e3/DataEntry_NavigationButtons_Class.rar/file