MTNQ > 17-06-17, 06:35 AM
(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
tranthanhan1962 > 17-06-17, 08:18 AM
cannguyen > 17-06-17, 09:26 AM
(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.
cannguyen > 17-06-17, 09:41 AM
(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
ongke0711 > 17-06-17, 09:42 AM
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
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
tieu_ngao > 17-06-17, 02:23 PM
(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
datNgay_Max = DateValue(Mid(lngMaBN_Max, 5, 2) & "/" & Mid(lngMaBN_Max, 3, 2) & "/" & Left(lngMaBN_Max, 2))
tranthanhan1962 > 17-06-17, 04:49 PM
(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"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.
Cám ơn bác
cannguyen > 18-06-17, 12:18 AM
(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
----------------------------------------------
maidinhdan > 18-06-17, 01:32 AM
MTNQ > 18-06-17, 10:52 AM
(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:Nếu mình muốn lấy mã theo dạng: yyyymmdd001 kiểu dữ liệu của mình là textMã:datNgay_Max = DateValue(Mid(lngMaBN_Max, 5, 2) & "/" & Mid(lngMaBN_Max, 3, 2) & "/" & Left(lngMaBN_Max, 2))
thì làm thế nào?
datNgay_Max = Format(Mid(lngMaBN_Max, 5, 2) & "/" & Mid(lngMaBN_Max, 3, 2) & "/" & Left(lngMaBN_Max, 2), "dd/mm/yy")