(17-06-17, 12:42 AM)cannguyen Đã viết: Cám ơn góp ý của bác
Bản chính thức của mình đã fix mấy lỗi này lâu rồi:
- Mã BN đáp ứng cho trường hợp 1 ngày có 9,999 bệnh nhân
- Nút thêm không cho phép lưu ngay. Chỉ khi nào nhấn nút Lưu và nhập đày đủ thông tin yêu cầu mới cho lưu
- Nói chung ứng dụng đang chạy ok cho 1 máy, đã đưa vào sử dụng 4 tháng nay thấy ổn, giờ chỉ muốn fix lỗi nhập nhiều máy thôi
File mình gửi lên là file cũ chủ yếu nhờ các bác giúp về phần nhập nhiều máy không bị trùng mã thôi còn các vấn đề khác các bác không cần quan tâm nhé, sẽ mất thời gian của các bác
Bác có file demo gửi giúp em với
Cám ơn bác

File của bạn đây:
http://www.mediafire.com/file/my2x1d7x7y4q7gh/PK1.rar

Cách xử lý mã có số liên tục dạng kèm ngày và đôi khi kèm cả giờ nữa trên nhiều máy đã làm hao tốn tâm tư của biết bao Software writer trên thế giới. Mình nói trên thế giới vì cũng đã từng tham gia nhiều diễn đàn về chuyện này từ lâu. Và chắc chắn không làm được. Việc này không phải chỉ vì kỹ thuật mà là nguyên lý. "Không ai có thể quản lý việc gõ phím hoặc click chuột đồng thời khi nhiều máy thực hiện chung một công việc. mà công việc đó là tạo một số kế tiếp với điều kiện không được trùng". Vì nó là nguyên lý nên ta phải chấp nhận như chấp nhận tiên đề Euclid. 

(17-06-17, 08:18 AM)tranthanhan1962 Đã viết: Cách xử lý mã có số liên tục dạng kèm ngày và đôi khi kèm cả giờ nữa trên nhiều máy đã làm hao tốn tâm tư của biết bao Software writer trên thế giới. Mình nói trên thế giới vì cũng đã từng tham gia nhiều diễn đàn về chuyện này từ lâu. Và chắc chắn không làm được. Việc này không phải chỉ vì kỹ thuật mà là nguyên lý. "Không ai có thể quản lý việc gõ phím hoặc click chuột đồng thời khi nhiều máy thực hiện chung một công việc. mà công việc đó là tạo một số kế tiếp với điều kiện không được trùng". Vì nó là nguyên lý nên ta phải chấp nhận như chấp nhận tiên đề Euclid. 

Cái này chắc không đúng lắm bác. Trước kia em làm phòng triển khai trong cty phần mềm. Việc phần mềm cài cho nhiều máy, nhiều người sử dụng và thao tác trên 1 form là bình thường mà bác. Sếp em viết bằng VisualStudio
Cám ơn bác

(17-06-17, 06:35 AM)MTNQ Đã viết:

(17-06-17, 12:42 AM)cannguyen Đã viết: Cám ơn góp ý của bác
Bản chính thức của mình đã fix mấy lỗi này lâu rồi:
- Mã BN đáp ứng cho trường hợp 1 ngày có 9,999 bệnh nhân
- Nút thêm không cho phép lưu ngay. Chỉ khi nào nhấn nút Lưu và nhập đày đủ thông tin yêu cầu mới cho lưu
- Nói chung ứng dụng đang chạy ok cho 1 máy, đã đưa vào sử dụng 4 tháng nay thấy ổn, giờ chỉ muốn fix lỗi nhập nhiều máy thôi
File mình gửi lên là file cũ chủ yếu nhờ các bác giúp về phần nhập nhiều máy không bị trùng mã thôi còn các vấn đề khác các bác không cần quan tâm nhé, sẽ mất thời gian của các bác
Bác có file demo gửi giúp em với
Cám ơn bác

File của bạn đây:
http://www.mediafire.com/file/my2x1d7x7y4q7gh/PK1.rar

Cám ơn bạn rất nhiều.
Hiện tại mình không có máy nên chưa test được. Hi vọng là ok

Đối với trường hợp nhiều User cùng nhập liệu một Form thì cũng có một cách giải quyết, có thể chưa hoàn haỏ nhưng vẫn đáp ứng yêu cầu không nhập trùng Số Thứ Tự (trong trường hợp này là MaBN).


Vấn đề:
- 2 hay nhiều User cùng mở form 1 thời điểm để tạo record mới, khi đó cả 2 nơi đều tạo ra số TT giống nhau. Sau đó ai lưu trước sẽ được cập nhật vào table, ai lưu sau thì sẽ báo lỗi trùng số TT.

Giải pháp:
- Dùng 1 table khác để lưu Số TT được tạo ra tự động. Ví dụ đặt tên là tblSoTT. Table này chỉ cần 2 field: [SoTT] và [NgayPS]. Field [NgayPS] phục vụ cho việc Reset số TT sẽ nói sau.
- Khi User mở Form nhập liệu sẽ không tạo MaBN ngay mà chỉ khi bấm nút [Save] hoặc di chuyển qua record khác thì mới bắt đầu kiểm tra tblSoTT để lấy ra số TT mới nhất gán vào MaBN. Khi chạy hàm kiểm tra, lấy số TT thì cũng Lock table này luôn (sau khi [Save] sẽ unlock nó). Nếu User sau cũng bấm nút [Save] thì không truy cập vào table tblSoTT được nữa sẽ báo lỗi. Khi đó ta bẫy lỗi này bằng cách “câu giờ” cho User 2 chờ 1 chút rồi mới truy cập lại table tblSoTT, nếu thành công sẽ có được số TT mới không trùng. Thời gian “câu giờ” này thực sự không đáng kể vì thao tác Lưu dữ liệu chỉ tính = millisecond.
- Công việc chính là nằm ở hàm lấy số TT và gán số TT mới cho table tblSoTT. Thủ tục là sau khi lấy số TT từ field [SoTT] gán vào biến, sẽ tự động tạo ra SoTT mới để sẳn đó (= [SoTT]+1) sau đó lưu ngược lại vào table.
- Công việc thứ 2 là “câu giờ”: Sử dụng hàm DoEvents cho đến khi kết nối được.

Trong bài này tôi giải quyết 2 việc là: Tạo Mã BN và Reset lại MaBN khi qua ngày khác. Hàm ResetSoTT() sẽ tùy chọn reset theo Ngày/ Tháng/ Năm (reset như vậy cũng đủ rồi chứ reset kiểu khác nữa thì phức tạp cuộc đời quá). Lưu ý hàm ResetSoTT() này chỉ phù hợp với code theo bài này thôi nhé chứ không áp dụng chung như hàm Reset của bác Dân đâu.
Lưu ý: Field MaBN là dạng Number nên đổi từ Long -> Double để có thể lưu đủ 11 chữ số như file của bạn.

Sau đây là code của các hàm này.
- Tạo 1 module tên basSoTT và copy code đoạn này:

Mã PHP:

Option Explicit
[/font]

Public Enum KieuResetSTT
   Ngay = 1
   Thang = 2
   Nam = 3
End Enum

Public Function LaySoThuTu() As Long

'---------------------------------------------------------
' Lay So thu tu và tu dong tang 1 don vi.
'---------------------------------------------------------

   Dim db As DAO.Database
   Dim rst As DAO.Recordset
   Dim intKhoaRecord As Integer
   Dim intThuLai As Integer
   Dim lngSoLan As Long
   Dim lngX As Long

   ' Thiet lap so lan thuc hien lai (Retries) .
   Const conMaxSoLanThuLai = 5
   Const conMinDelay = 1
   Const conMaxDelay = 10

   On Error GoTo HandleErr
   Set db = CurrentDb()
   intKhoaRecord = False    'Khi user khác dang nhap lieu va bam nut [SAVE], record bi khoa
   Do While True  'Thuc hien lai viec mo table lay so thu tu bao nhieu lan.
       For intThuLai = 0 To conMaxSoLanThuLai
           On Error Resume Next
           Set rst = db.OpenRecordset("tblSoTT", _
                                      dbOpenDynaset, dbDenyWrite + dbDenyRead)
           If Err = 0 Then
               intKhoaRecord = True
               Exit For
           Else    'Câu giò nêu phát sinh loi
               lngSoLan = intThuLai ^ 2 * Int((conMaxDelay - conMinDelay + 1) * Rnd + conMinDelay)
               For lngX = 1 To lngSoLan
                   DoEvents
               Next lngX
           End If
       Next intThuLai

       On Error GoTo HandleErr
       If Not intKhoaRecord Then
           If MsgBoxUni("Ch" & ChrW(432) & "a gán " & ChrW(273) & ChrW(432) & ChrW(7907) & "c s" & ChrW(7889) & " th" & ChrW(7913) & " t" & ChrW(7921) & " cho b" & ChrW(7879) & "nh nhân: B" & ChrW(7841) & "n mu" & ChrW(7889) & "n th" & ChrW(7917) & " l" & ChrW(7841) & "i không?", _
                     vbQuestion + vbYesNo) = vbYes Then
               intThuLai = 0
           Else
               Exit Do
           End If
       Else
           Exit Do
       End If
   Loop
   
   'Khi table SoTT khong bi khoa (User khác da thuc hie lenh [Save] xong)
   If intKhoaRecord Then
       LaySoThuTu = rst![SoTT]
       rst.Edit
       rst!SoTT = rst![SoTT] + 1
       rst!NgayPS = date
       rst.Update
       rst.Close
   Else
       LaySoThuTu = -1 'Dung de Cancel Update cho su kien BeforeUpdate cua form
   End If
   
   Set rst = Nothing
   Set db = Nothing
   
ExitHere:
   Exit Function
HandleErr:
   MsgBox Err & ": " & Err.Description, , "Hàm LaySoThuTu"
   Resume ExitHere
   
End Function

Public Function ResetSoTT(ByVal Kieu As KieuResetSTT) As Boolean
   Dim db As DAO.Database
   Dim rs As DAO.Recordset
   Dim blnReturn As Boolean

   blnReturn = False

   Set db = CurrentDb
   Set rs = db.OpenRecordset("tblSoTT", dbOpenDynaset)
   If rs.RecordCount = 0 Then
       blnReturn = False
       'Exit Function
   Else
       Select Case Kieu
       Case Ngay
           If rs!NgayPS = date Then
               blnReturn = False
           Else
               blnReturn = True
           End If
       Case Thang
           If Month(rs!NgayPS) = Month(date) Then
               blnReturn = False
           Else
               blnReturn = True
           End If
       Case Nam
           If Year(rs!NgayPS) = Year(date) Then
               blnReturn = False
           Else
               blnReturn = True
           End If
       End Select
   End If

   If blnReturn Then
       rs.Edit
       rs!SoTT = 1
       rs!NgayPS = date
       rs.Update
       rs.Close
   End If
   
   Set rs = Nothing
   Set db = Nothing
   
[font=Tahoma]End Function 


- Đối với Form: textbox chứa MaBN sẽ có Enabled=No. Có 2 sự kiện cho Form:
   + Khi Form_Open sẽ chạy hàm ResetSoTT()
   + Form BeforeUpdate: chạy Sub TaoMaBN

Mã PHP:

Sub TaoMaBN()[/font]
' Lay so thu tu va gan vao txtMaBN
   Dim lngSoTT As Long
   Dim Cancel As Integer
   
   If IsNull(Me.MaBN) Then
       lngSoTT = LaySoThuTu()
       ' Neu chua lay duoc So thu thu...
       If lngSoTT < 1 Then
           ' Huy viec cap nhat.
           Cancel = True
       Else
           Me.MaBN = Val(Format(Me.NgayDau, "yyyymmdd") & Format(lngSoTT, "000")) 'VD: 20170615001
       End If
   End If

[font=Tahoma]End Sub 


Tôi có tạo 1 form giả lập như có User đang sử dụng để Lock record của table tblSoTT. Các bạn chạy để test vụ câu giờ nhé.

Link file demo: http://www.mediafire.com/file/pu3jhwfy2e...sed%29.rar


*Một số góp ý thêm về file của bạn cannguyen:
- Như bạn MTNQ đã nói bạn nên sửa lại việc đặt tên các textbox trên Form để tránh nhầm lẫn. Cơ bản nhất là thêm tiền tố "txt", "cbo", "cmd" v.v.. cho các control tương ứng như TextBox, Commbo box, Command button..
- Chú ý đặt tên cho các Control trên Form để sau này nhìn vô code còn biết nó dùng cho Control nào. Ví dụ: code của bạn " Private Sub Command37_Click". Cách này sẽ bắt người sửa code cho bạn dò xem Command37 là cái thằng nào trong một đống thằng trên Form.
- Tạo thói quen phải có dòng "Option Explicit" trên cùng trong tất cả các Module code VBA. Cái này dùng để kiểm tra xem bạn có tạo các biến nào mà chưa khai báo, nó sẽ báo lỗi cho bạn biết. Vd: Trong Form của bạn có đoạn code 
----------------------------------
Private Sub Form_Load()
    OrderBy = yes
End Sub
--------------------------------
==> làm gì có code OrderBy=yes

Phải sửa lại là
-----------------------------------------------
Private Sub Form_Load()
    Me.OrderBy = "[MaBN] ASC"
    Me.OrderByOn = True
End Sub
----------------------------------------------

(16-06-17, 09:44 PM)MTNQ Đã viết:

(15-06-17, 02:48 PM)cannguyen Đã viết: Chào các bạn
Mình cần tạo form Bệnh nhân với yêu cầu Mã khách hàng sắp xếp theo ngày. Cấu trúc Mã BN như sau: Năm+Tháng+Ngày+STT. Ví dụ: 2017061501
Mình viết lệnh cho sự kiện như sau:

If [NgayNay] = [NgayTruoc] Then
L2 = BNCuoi + 1
Else
L2 = 1
End If
DoCmd.GoToRecord , , acNewRec
MaBN = Year(NgayDau) & Right(("0" & Month(NgayDau)), 2) & Right(("0" & Day(NgayDau)), 2) & Right(("00" & L2), 2)

Nhâp 1 máy thì ok nhưng nhập nhiều máy thì lỗi trùng mã bệnh nhân. Nhờ các bạn giúp nhé
Mình gửi kèm link: https://drive.google.com/open?id=0B7F3oA...HNoeE5nNm8

Cám ơn các bạn

Chào bạn!
Xem qua file của bạn mình có vài góp ý như sau:
-Nếu trường MaBN là kiểu Long Integer thì không nên lấy theo kiểu yyyymmdd00, Làm như vậy sẽ không ổn nếu trong ngày có hơn 100 BN khám
->Nên Format theo kiểu yymmdd0000, tức là chỉ lấy 2 số cuối của năm

-Nên tách hàm tạo MaBN riêng để dễ chỉnh sửa và sử lý lỗi

-Không nên tạo MaBN ngay khi "thêm mới" vì làm như vậy sẽ có nguy cơ tạo ra nhiều Record trống, chỉ có MaBN mà không có dữ liệu
-> Chỉ tạo MaBN sau khi đã nhập tên BN (Gọi hàm tạo MaBN ở sự kiện TenBN_AfterUpdate)

-Điều khiển nào không cho người dùng chỉnh sửa (như MaBN) thì phải khoá lại (Locked = yes). Không nên đặt tên các điều khiển trùng với tên trường trong table để tránh nhầm lẫn khi viết code....


Sau đây là hàm tạo mã BN:

Mã:

Private Function fcTaoMaBN() As Long
   Dim lngMaBN_Max As Long
   Dim lngMaBN_New As Long
   Dim datNgay_Max As Date
   
   lngMaBN_Max = Nz(DMax("[MaBN]", "BenhNhan"), 0)
   If lngMaBN_Max <> 0 Then
       datNgay_Max = DateValue(Mid(lngMaBN_Max, 5, 2) & "/" & Mid(lngMaBN_Max, 3, 2) & "/" & Left(lngMaBN_Max, 2))
       'Debug.Print datNgay_Max
       If datNgay_Max >= date Then
           If datNgay_Max > date Then
               MsgBox "Ngay thang tren he thong khong phu hop, vui long lien he Admin ", vbCritical, "Luu y"
           End If
           lngMaBN_New = lngMaBN_Max + 1
       Else
           lngMaBN_New = Val(Format(date, "yymmdd") & "0000") + 1
       End If
   Else
       lngMaBN_New = Val(Format(date, "yymmdd") & "0000") + 1
   End If
   
   fcTaoMaBN = lngMaBN_New
End Function

-Code cho sự kiện AfterUpdate của TenBN: 

Mã:

Private Sub TenBN_AfterUpdate()
   If Nz(Me.TenBN, "") = "" Then Exit Sub

If Nz(MaBN, 0) = 0 Then
       MaBN = fcTaoMaBN
       DaLuu = "Y"
   DoCmd.RunCommand acCmdSaveRecord
   End If
End Sub

Điều kiện  "If Nz(MaBN, 0) = 0 Then" rất quan trọng vì nếu thiếu thì khi chỉnh sửa tên Bn nó lại tạo thêm ra một MaBn mới
Sau khi tạo MaBN rồi thì nhớ câu thần chú DoCmd.RunCommand acCmdSaveRecord. Nếu không thì ở máy khác sẽ không nhận biết được sự tồn tại của nó và vấn đề trùng mã lại diễn ra   

-Như vậy code cho nút mới chỉ còn là:

Mã:

Private Sub moi_Click()
   DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

   LockCtrls False
   DoCmd.GoToRecord , , acNewRec
   TenBN.SetFocus
End Sub

Thủ tục LockCtrls nhằm tránh viết nhiều lần cùng một đoạn mã:

Mã:

Sub LockCtrls(blnLock As Boolean)
   MaBN.Enabled = Not blnLock
   TenBN.Enabled = Not blnLock
   NamSinh.Enabled = Not blnLock
   DiaChi.Enabled = Not blnLock
   DienThoai.Enabled = Not blnLock
   GhiChu.Enabled = Not blnLock
   GioiTinh.Enabled = Not blnLock
   NgayBHYT.Enabled = Not blnLock
   SoBHYT.Enabled = Not blnLock
   luu.Enabled = Not blnLock
   moi.Enabled = blnLock
   I.Enabled = blnLock
   xoa.Enabled = blnLock
   SUa.Enabled = blnLock
End Sub

Khi muốn mở hoặc khoá các điều khiển trên form bạn chỉ cần gọi LockCtrls False hoặc LockCtrls True

Ví dụ:

Mã:

Private Sub Form_Open(Cancel As Integer)
'MaBN.Enabled = False
'TenBN.Enabled = False
'NamSinh.Enabled = False
'DiaChi.Enabled = False
'DienThoai.Enabled = False
'GhiChu.Enabled = False
'GioiTinh.Enabled = False
'luu.Enabled = False
'NgayDau.Enabled = False
'SoBHYT.Enabled = False
'NgayBHYT.Enabled = False
   LockCtrls True
End Sub

và:

Mã:

Private Sub sua_Click()
   LockCtrls False
End Sub

MTNQ giải thích giùm mình đoạn này, mình chưa hiểu:Nếu mình muốn lấy mã theo dạng: yyyymmdd001 kiểu dữ liệu của mình là text
thì làm thế nào?

(17-06-17, 09:26 AM)cannguyen Đã viết: Cái này chắc không đúng lắm bác. Trước kia em làm phòng triển khai trong cty phần mềm. Việc phần mềm cài cho nhiều máy, nhiều người sử dụng và thao tác trên 1 form là bình thường mà bác. Sếp em viết bằng VisualStudio
Cám ơn bác

"Việc phần mềm cài cho nhiều máy, nhiều người sử dụng và thao tác trên 1 form là bình thường mà bác." OK! Việc này thì cả thế giới điều biết, cả thế giới điều làm, Viết bằng ngôn ngữ nào cũng được, vấn đề ở đây là việc tạo mã theo thứ tự không trùng với điều kiện máy xử lý đồng loạt "kiểu của bạn". "Có khi" mã kế tiếp được tạo ra đồng thời. Vấn đề ở đây là cùng một số kế tiếp sẽ tạo ra lỗi trùng dữ liệu. Nếu bạn nói sếp của bạn giải quyết được vấn đề này hãy nhờ sếp bạn tư vấn. Ở đây không phải là tư vấn viết bằng ngôn ngữ nào, mà hướng giải quyết như thế nào. Ngoài cách sử dụng lệnh khóa các máy khác khi một máy tạo mã (cái này cũng giống như sử dụng 1 máy). Thì không còn phương pháp nào khác.

(17-06-17, 09:42 AM)ongke0711 Đã viết: Đối với trường hợp nhiều User cùng nhập liệu một Form thì cũng có một cách giải quyết, có thể chưa hoàn haỏ nhưng vẫn đáp ứng yêu cầu không nhập trùng Số Thứ Tự (trong trường hợp này là MaBN).


Vấn đề:
- 2 hay nhiều User cùng mở form 1 thời điểm để tạo record mới, khi đó cả 2 nơi đều tạo ra số TT giống nhau. Sau đó ai lưu trước sẽ được cập nhật vào table, ai lưu sau thì sẽ báo lỗi trùng số TT.

Giải pháp:
- Dùng 1 table khác để lưu Số TT được tạo ra tự động. Ví dụ đặt tên là tblSoTT. Table này chỉ cần 2 field: [SoTT] và [NgayPS]. Field [NgayPS] phục vụ cho việc Reset số TT sẽ nói sau.
- Khi User mở Form nhập liệu sẽ không tạo MaBN ngay mà chỉ khi bấm nút [Save] hoặc di chuyển qua record khác thì mới bắt đầu kiểm tra tblSoTT để lấy ra số TT mới nhất gán vào MaBN. Khi chạy hàm kiểm tra, lấy số TT thì cũng Lock table này luôn (sau khi [Save] sẽ unlock nó). Nếu User sau cũng bấm nút [Save] thì không truy cập vào table tblSoTT được nữa sẽ báo lỗi. Khi đó ta bẫy lỗi này bằng cách “câu giờ” cho User 2 chờ 1 chút rồi mới truy cập lại table tblSoTT, nếu thành công sẽ có được số TT mới không trùng. Thời gian “câu giờ” này thực sự không đáng kể vì thao tác Lưu dữ liệu chỉ tính = millisecond.
- Công việc chính là nằm ở hàm lấy số TT và gán số TT mới cho table tblSoTT. Thủ tục là sau khi lấy số TT từ field [SoTT] gán vào biến, sẽ tự động tạo ra SoTT mới để sẳn đó (= [SoTT]+1) sau đó lưu ngược lại vào table.
- Công việc thứ 2 là “câu giờ”: Sử dụng hàm DoEvents cho đến khi kết nối được.

Trong bài này tôi giải quyết 2 việc là: Tạo Mã BN và Reset lại MaBN khi qua ngày khác. Hàm ResetSoTT() sẽ tùy chọn reset theo Ngày/ Tháng/ Năm (reset như vậy cũng đủ rồi chứ reset kiểu khác nữa thì phức tạp cuộc đời quá). Lưu ý hàm ResetSoTT() này chỉ phù hợp với code theo bài này thôi nhé chứ không áp dụng chung như hàm Reset của bác Dân đâu.
Lưu ý: Field MaBN là dạng Number nên đổi từ Long -> Double để có thể lưu đủ 11 chữ số như file của bạn.

Sau đây là code của các hàm này.
- Tạo 1 module tên basSoTT và copy code đoạn này:

Mã PHP:

Option Explicit
[/font]

Public Enum KieuResetSTT
   Ngay = 1
   Thang = 2
   Nam = 3
End Enum

Public Function LaySoThuTu() As Long

'---------------------------------------------------------
' Lay So thu tu và tu dong tang 1 don vi.
'---------------------------------------------------------

   Dim db As DAO.Database
   Dim rst As DAO.Recordset
   Dim intKhoaRecord As Integer
   Dim intThuLai As Integer
   Dim lngSoLan As Long
   Dim lngX As Long

   ' Thiet lap so lan thuc hien lai (Retries) .
   Const conMaxSoLanThuLai = 5
   Const conMinDelay = 1
   Const conMaxDelay = 10

   On Error GoTo HandleErr
   Set db = CurrentDb()
   intKhoaRecord = False    'Khi user khác dang nhap lieu va bam nut [SAVE], record bi khoa
   Do While True  'Thuc hien lai viec mo table lay so thu tu bao nhieu lan.
       For intThuLai = 0 To conMaxSoLanThuLai
           On Error Resume Next
           Set rst = db.OpenRecordset("tblSoTT", _
                                      dbOpenDynaset, dbDenyWrite + dbDenyRead)
           If Err = 0 Then
               intKhoaRecord = True
               Exit For
           Else    'Câu giò nêu phát sinh loi
               lngSoLan = intThuLai ^ 2 * Int((conMaxDelay - conMinDelay + 1) * Rnd + conMinDelay)
               For lngX = 1 To lngSoLan
                   DoEvents
               Next lngX
           End If
       Next intThuLai

       On Error GoTo HandleErr
       If Not intKhoaRecord Then
           If MsgBoxUni("Ch" & ChrW(432) & "a gán " & ChrW(273) & ChrW(432) & ChrW(7907) & "c s" & ChrW(7889) & " th" & ChrW(7913) & " t" & ChrW(7921) & " cho b" & ChrW(7879) & "nh nhân: B" & ChrW(7841) & "n mu" & ChrW(7889) & "n th" & ChrW(7917) & " l" & ChrW(7841) & "i không?", _
                     vbQuestion + vbYesNo) = vbYes Then
               intThuLai = 0
           Else
               Exit Do
           End If
       Else
           Exit Do
       End If
   Loop
   
   'Khi table SoTT khong bi khoa (User khác da thuc hie lenh [Save] xong)
   If intKhoaRecord Then
       LaySoThuTu = rst![SoTT]
       rst.Edit
       rst!SoTT = rst![SoTT] + 1
       rst!NgayPS = date
       rst.Update
       rst.Close
   Else
       LaySoThuTu = -1 'Dung de Cancel Update cho su kien BeforeUpdate cua form
   End If
   
   Set rst = Nothing
   Set db = Nothing
   
ExitHere:
   Exit Function
HandleErr:
   MsgBox Err & ": " & Err.Description, , "Hàm LaySoThuTu"
   Resume ExitHere
   
End Function

Public Function ResetSoTT(ByVal Kieu As KieuResetSTT) As Boolean
   Dim db As DAO.Database
   Dim rs As DAO.Recordset
   Dim blnReturn As Boolean

   blnReturn = False

   Set db = CurrentDb
   Set rs = db.OpenRecordset("tblSoTT", dbOpenDynaset)
   If rs.RecordCount = 0 Then
       blnReturn = False
       'Exit Function
   Else
       Select Case Kieu
       Case Ngay
           If rs!NgayPS = date Then
               blnReturn = False
           Else
               blnReturn = True
           End If
       Case Thang
           If Month(rs!NgayPS) = Month(date) Then
               blnReturn = False
           Else
               blnReturn = True
           End If
       Case Nam
           If Year(rs!NgayPS) = Year(date) Then
               blnReturn = False
           Else
               blnReturn = True
           End If
       End Select
   End If

   If blnReturn Then
       rs.Edit
       rs!SoTT = 1
       rs!NgayPS = date
       rs.Update
       rs.Close
   End If
   
   Set rs = Nothing
   Set db = Nothing
   
[font=Tahoma]End Function 


- Đối với Form: textbox chứa MaBN sẽ có Enabled=No. Có 2 sự kiện cho Form:
   + Khi Form_Open sẽ chạy hàm ResetSoTT()
   + Form BeforeUpdate: chạy Sub TaoMaBN

Mã PHP:

Sub TaoMaBN()[/font]
' Lay so thu tu va gan vao txtMaBN
   Dim lngSoTT As Long
   Dim Cancel As Integer
   
   If IsNull(Me.MaBN) Then
       lngSoTT = LaySoThuTu()
       ' Neu chua lay duoc So thu thu...
       If lngSoTT < 1 Then
           ' Huy viec cap nhat.
           Cancel = True
       Else
           Me.MaBN = Val(Format(Me.NgayDau, "yyyymmdd") & Format(lngSoTT, "000")) 'VD: 20170615001
       End If
   End If

[font=Tahoma]End Sub 


Tôi có tạo 1 form giả lập như có User đang sử dụng để Lock record của table tblSoTT. Các bạn chạy để test vụ câu giờ nhé.

Link file demo: http://www.mediafire.com/file/pu3jhwfy2e...sed%29.rar


*Một số góp ý thêm về file của bạn cannguyen:
- Như bạn MTNQ đã nói bạn nên sửa lại việc đặt tên các textbox trên Form để tránh nhầm lẫn. Cơ bản nhất là thêm tiền tố "txt", "cbo", "cmd" v.v.. cho các control tương ứng như TextBox, Commbo box, Command button..
- Chú ý đặt tên cho các Control trên Form để sau này nhìn vô code còn biết nó dùng cho Control nào. Ví dụ: code của bạn " Private Sub Command37_Click". Cách này sẽ bắt người sửa code cho bạn dò xem Command37 là cái thằng nào trong một đống thằng trên Form.
- Tạo thói quen phải có dòng "Option Explicit" trên cùng trong tất cả các Module code VBA. Cái này dùng để kiểm tra xem bạn có tạo các biến nào mà chưa khai báo, nó sẽ báo lỗi cho bạn biết. Vd: Trong Form của bạn có đoạn code 
----------------------------------
Private Sub Form_Load()
    OrderBy = yes
End Sub
--------------------------------
==> làm gì có code OrderBy=yes

Phải sửa lại là
-----------------------------------------------
Private Sub Form_Load()
    Me.OrderBy = "[MaBN] ASC"
    Me.OrderByOn = True
End Sub
----------------------------------------------

cám ơn giúp đỡ và góp ý của ongke....nhé. Mấy hôm nay em bận quá nên chưa test được. Khi nào rảnh em test vướng mắc sẽ nhờ bác sau nhé

Xin tham gia 1bài viết về vấnđến trùng mã này. Em thấy bài viết của anh Bảo rất hay, và bổ sung 1 cách nửa.

Bước 1.Ở file database.mdb tạo mới 1query có tính năng Add mới MaBN mới và tăng thêm 1 và table
Bước 2. Ở file PM.mdb viết 

* nút Lấy mã gồm các sự kiện sau.

( ' Kiểm tra query trên database.mdb có ai đang mở không, nếu không có thì làm việc sau:
{' Truy vấn và chạy query trên database.mdb;
' Trả về mãBN mới nhất vào ô Textbox trên form
' Ra lệnh ngắt kết nối đến Query}

Nếu có người đang mở  query trên database.mdb
{ ' Viết đoạn code cho nó chờ khoảng 2s, Sau 2 giây quay lại kiểm tra tiếp ở bước trên, cứ như thế}
)

* Nút lưu thay vì là Thêm mới,thì ta viết lệnh Chỉnh sửa ngay cái dòng có MaBN vừa lấy được.

Hết.

(17-06-17, 02:23 PM)tieu_ngao Đã viết: MTNQ giải thích giùm mình đoạn này, mình chưa hiểu:

Mã:

datNgay_Max = DateValue(Mid(lngMaBN_Max, 5, 2) & "/" & Mid(lngMaBN_Max, 3, 2) & "/" & Left(lngMaBN_Max, 2))

Nếu mình muốn lấy mã theo dạng: yyyymmdd001 kiểu dữ liệu của mình là text
thì làm thế nào?

Xin lỗi. Hàm  DateValue  trong trường hợp này có thể trả về giá trị không như mong muốn nếu format ngày giờ trên hệ thống khác "dd/MM/yyyy" 
Nên sửa lại như sau


-Nếu muốn format theo kiểu yyyymmdd001 thì :
datNgay_Max = Format(Mid(lngMaBN_Max, 7, 2) & "/" & Mid(lngMaBN_Max, 5, 2) & "/" & Left(lngMaBN_Max, 4), "dd/mm/yy")

Tuy nhiên phải sửa hàm fcTaoMaBN lại cho phù hợp với dữ liệu kiểu text