II. Khảo sỏt hệ thống
6. Cài đặt và chạy chương trỡnh
Frm.xemluong: Màn hỡnh hiển thị xem lương cỏn bộ
CHƯƠNG V:
ĐÁNH GIÁ VÀ PHÁT TRIỂN ĐỀ TÀI
Quỏ trỡnh khảo sỏt, thực hiện và hoàn thành đề tài, thỡ chương trỡnh đó cho chỳng ta cú được cỏi nhỡn tổng quỏt về hệ thống quản lý cỏn bộ tiền lương
của một doanh nghiệp. Chương trỡnh đó giỳp rất nhiều cho cỏn bộ nghiệp vụ nhõn sự, tiền lương trong việc cập nhập, chỉnh sửa, tớnh lương, quản lý, tỡm kiếm, đưa ra cỏc bỏo cỏo, bỏo biểu về thụng tin cỏn bộ rất dễ dàng và chớnh xỏc..Nhưng do thời gian cú hạn và kiến thức cũn hạn hẹp nờn chương trỡnh khụng trỏnh khỏi những thiếu xút..như chương trỡnh chưa đưa ra được phần quản trị hệ thống, phõn quyền cho cho người sử dụng, chưa đưa ra được một quy trỡnh quản lý sao lưu backup dữ liệu…Trong thời gian tới, e sẽ cố gắng hoàn thiện chương trỡnh và phỏt triển chương trỡnh thờm nhiều module nữa..như xõy dựng hệ thống chấm cụng tự động, hệ thống quản lý đơn hàng..tạo dựng database chung cho chương trỡnh để chương trỡnh ngày một ưu việt.
Cuối cựng, em xin chõn thành cảm ơn Ths. Nguyễn Thanh Hương giảng viờn bộ mụn Cụng nghệ thụng tin Trường Đại Học Kinh Tế Quốc Dõn đó tận tỡnh chỉ bảo hướng dẫn em hoàn thành đề tài này.Cỏm ơn quý cụng ty TNHH Minh Trớ đó tạo điều kiện cho e khảo sỏt và thực tập tại cụng ty để e cú thể hoàn thành được đề tài này.
NHẬN XẫT CỦA GIÁO VIấN HƯỚNG DẪN
……… ……… ………
……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ………
XÁC NHẬN CỦA CƠ QUAN THỰC TẬP
……… ……… ………
……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… ……… Kí VÀ ĐểNG DẤU
TÀI LIỆU THAM KHẢO 1. Cơ Sở Dữ Liệu Quan Hệ
Lờ Tiến Vương
2. Phõn Tớch & Thiết Kế Hệ Thống
3. Cơ Sở Dữ Liệu & Phõn Tớch Thiết Kế Hệ Thống Thụng Tin Quản Lý
Nguyễn Hữu Trọng
4. Tự Học Lập Trỡnh Cơ Sở Dữ Liệu Visual Basic 6.0 tập 1&2
Nguyễn Đỡnh Tờ(chủ biờn)
5. Những Bài Thực Hành Cơ Sở Dữ Liệu Cơ Sở Visual Basic
Đinh Xuõn Lõm
6. Cơ Sở Dữ Liệu Visual Basic
Nguyễn Thị Ngọc Mai
7. Tin Học Văn Phũng Access 2000
Nguyễn Sĩ Dũng
8. Lập Trỡnh Access 2000
ễng Văn Thụng
PHỤ LỤC CODE CỦA CHƯƠNG TRèNH
Dim ketthuc
Dim myPathhoso As String Dim myPathluong As String
Private Sub MDIForm_Load() ' Load frmgioithieu
MDImain.WindowState = 2 Language (True)
End Sub
Sub MDIForm_Unload(Cancel As Integer) Me.mnuexit_Click
End Sub
Private Sub mnuAboutSalary_Click() frmAbout.Show
End Sub
Private Sub mnuAccordingSalary_Click() ' frmTCsach.Show
End Sub
Private Sub mnuAllowanceFiles_Click() frmPhuCap.Show
End Sub
Private Sub mnuArrangeIcon_Click() Me.Arrange 3 'dbArrangeIcon End Sub
Private Sub mnucascade_Click() Me.Arrange 0
End Sub
Private Sub mnuCoefficientforsalary_Click() frmnhapheso.Show
End Sub
Private Sub mnuEnglish_Click()
If MDImain.mnuEnglish.Checked = False Then MDImain.mnuVietnamese.Checked = False MDImain.mnuEnglish.Checked = True Language (False) End If End Sub Sub mnuexit_Click()
ketthuc = MsgBox("Bạn muốn kết thúc tại đây! ", vbYesNo, "Thông báo") If ketthuc = vbYes Then
End End If End Sub
Private Sub mnuLookUppersonal_Click() frmTracuuCb.Show
End Sub
Private Sub mnuLookupSalary_Click() frmTraCuuLuong.Show
End Sub
Private Sub mnuOpenFilesPersonal_Click() cdlmain.ShowOpen
myPathhoso = cdlmain.FileName End Sub
Private Sub mnupersonalfile_Click() frmhosocb.Show
End Sub
Private Sub mnurewardforsalary_Click() frmthuong.Show
End Sub
Private Sub mnusalaryfile_Click() frmluong.Show
End Sub
Private Sub mnusave_Click() Me.cdlmain.ShowSave End Sub
Private Sub mnuStatus_Click()
If Me.StatusBar1.Visible = False Then Me.mnuStatus.Checked = True Me.StatusBar1.Visible = True Else Me.StatusBar1.Visible = False Me.mnuStatus.Checked = False End If End Sub
Private Sub mnuTileHozizontally_Click() Me.Arrange 1
End Sub
Private Sub mnuTileVertically_Click() Me.Arrange 2
End Sub
Private Sub mnuToolsbars_Click() If Me.tlbmain.Visible = False Then Me.mnuToolsbars.Checked = True Me.tlbmain.Visible = True Else Me.tlbmain.Visible = False Me.mnuToolsbars.Checked = False End If
End Sub
Private Sub mnuVietnamese_Click()
If MDImain.mnuVietnamese.Checked = False Then MDImain.mnuEnglish.Checked = False
MDImain.mnuVietnamese.Checked = True Language (True)
End If End Sub
Private Sub tlbmain_ButtonClick(ByVal Button As ComctlLib.Button) Select Case Button.Key
Case "New"
file = InputBox(" Nhập vào Tên CSDL cần tạo", "Tao bảng cSDL mới") If Trim(file) = "" Then Exit Sub Else Maketable (file) End If Case "Open"
MsgBox "Banj chon mo" Case "Save"
MsgBox "Ban cho ghi" Case "Print"
MsgBox "ban cho in" Case "PrintReview"
MsgBox "Phần này dành cho bạn" Case "Exit"
MsgBox "choa bai" mnuexit_Click
End Select End Sub
'Đoạn chương trình nhằm chuẩn hoá tiếng việt
Function Chuan(XauVao As String, Thamso As Byte) As String Dim xau(1 To 50) As String
Dim kTdau Dim KTV Dim k As Byte Chuan = "" KTV = Trim(XauVao) For k = 1 To Len(KTV)
xau(k) = Mid(KTV, k, 1) Next k
Select Case Thamso Case 1
'tất các ký tự đầu được biến thành chữ hoa For k = 1 To Len(KTV)
xau(k) = Mid(KTV, k, 1) Next k
For i = 1 To Len(KTV)
If Asc(xau(1)) >= 168 And Asc(xau(1)) <= 174 Then xau(1) = Chr(Asc(xau(1)) - 7)
Else
xau(1) = UCase(xau(1)) End If
If Asc(xau(i)) = 32 Then
If (Asc(xau(i + 1))) >= 168 And Val(Asc(xau(i + 1))) <= 174 Then xau(i + 1) = Chr(Asc(xau(i + 1)) - 7) Else xau(i + 1) = UCase(xau(i + 1)) End If End If
Chuan = Chuan + xau(i) Next i
Case 2 ' chuẩn hoá các ký tự đầu tiên kTdau = Left(Trim(KTV), 1)
If Asc(kTdau) >= 168 And Asc(kTdau) <= 174 Then Chuan = Chr(Asc(kTdau) - 7) + Right(Trim(KTV), Len(Trim(KTV)) - 1)
Else
Chuan = UCase(kTdau) + Right(Trim(KTV), Len(Trim(KTV)) - 1) End If Case 3 ' tấ cả là chữ hoa Chuan = UCase(KTV) End Select End Function
Public Const myPathhoso = "c:\qlluong\QLuong.mdb" Public Const rptfilename = "c:\qlluong\"
Public PathReport As String Public Co As Boolean
Public Chiso As Byte
Function Doi_date(sdate As Variant) As Date Dim i As Byte
Dim vitri, k As Byte Dim Thang As String * 2 Dim Ngay As String * 2 Dim Nam As String * 4 sdate = Trim(sdate) Ngay = Mid(sdate, 1, 2) Thang = Mid(sdate, 4, 2) Nam = Mid(sdate, 7, 10)
Doi_date = Thang & "/" & Ngay & "/" & Nam End Function
Public Function CheckDate(sdate As String) As String If IsDate(sdate) = False Then
CheckDate = "" Exit Function End If
Dim i As Byte Dim vitri, k As Byte Dim Thang As String * 2 Dim Ngay As String * 2 Dim Nam As String * 4 Dim Sign(1) As String * 1 Sign(0) = "-" Sign(1) = "/" Thang = "" Ngay = "" vitri = 1 For i = 0 To 1
vitri = InStr(1, sdate, Sign(i)) If vitri <> 0 Then
Ngay = Mid(sdate, 1, vitri - 1) k = vitri + 1
vitri = InStr(vitri + 1, sdate, Sign(i)) If vitri <> 0 Then
Thang = Mid(sdate, k, vitri - k)
Nam = Mid(sdate, vitri + 1, Len(Trim(sdate)) - vitri) Exit For
End If Else End If Next i
If Len(Ngay) = 0 Or Len(Thang) = 0 Then CheckDate = ""
Exit Function End If
If Len(Trim(Ngay)) = 1 Then Ngay = "0" & Ngay If Len(Trim(Thang)) = 1 Then Thang = "0" & Thang If Int(Val(Thang)) > 12 Then CheckDate = "" Exit Function Else If Int(Val(Ngay)) > 31 Then CheckDate = "" Exit Function End If
CheckDate = Trim(Ngay & "/" & Thang & "/" & Nam) End If
End Function
Public Sub Language(Language As Boolean) Select Case Language
Case True With MDImain .mnuEnglish.Checked = False .mnuVietnamese.Checked = True .mnufiles.Caption = "Files" .mnuexit.Caption = "&Kết Thúc" .mnuView.Caption = "&Hiện ẩn" .mnuStatus.Caption = "T&rạng Thái" .mnutask.Caption = "&Nhiệm vụ" .mnuInput.Caption = "Nhập Dữ Liệu"
.mnuAllowanceFiles.Caption = "&Nhập Phụ Cấp ..." .mnuCoefficientforsalary.Caption = "&Hệ Số Lương ..." .mnupersonalfile.Caption = "Hồ &Sơ Can Bo ..."
.mnurewardforsalary.Caption = "Mức thưởng ..." .mnusalaryfile.Caption = "Lương ..."
.mnuLookUp.Caption = "&Tra Cứu ..."
.mnuLookUppersonal.Caption = "Tra cứu theo hồ &Sơ Nhân viên..." .mnuLookupSalary.Caption = "Tra cứu theo &lương ..."
.MnuTools.Caption = "Công Cụ"
.MnuLanguage.Caption = "&Ngôn ngữ Hiển Thị" .mnuEnglish.Caption = "&English"
.mnuVietnamese.Caption = "&Việt Nam" .mnuhelps.Caption = "&Trợ Giúp"
.mnuAboutSalary.Caption = "Thông Tin Về &Chương Trình ..." End With Case False With MDImain .mnuEnglish.Checked = True .mnuVietnamese.Checked = False .mnufiles.Caption = "Files" .mnuexit.Caption = "E&xit" .mnuView.Caption = "&View" .mnuStatus.Caption = "&Status" .mnutask.Caption = "&Task" .mnuInput.Caption = "Input"
.mnuAllowanceFiles.Caption = "&Allowance Files ..."
.mnuCoefficientforsalary.Caption = "&Ceofficient Fo Salary ..." .mnupersonalfile.Caption = "&Personal Files ..."
.mnurewardforsalary.Caption = "&Raward for Salary ..." .mnusalaryfile.Caption = "&Salary files ..."
.mnuLookUp.Caption = "&Look Up..."
.mnuLookUppersonal.Caption = "Look Up According &Personal ..." .mnuLookupSalary.Caption = "Look Up According &Salary ..." .MnuTools.Caption = "&Tools"
.MnuLanguage.Caption = "&Language " .mnuEnglish.Caption = "&English"
.mnuVietnamese.Caption = "&VietNamese" .mnuhelps.Caption = "&Helps"
.mnuAboutSalary.Caption = "&About Salry ..." End With
End Select End Sub
Public Sub chao()
Dim rec As Recordset Dim MySql As String 'Nạp Giói tính
With frmTracuuCb
.cbotracuucb(0).AddItem "Nam" .cbotracuucb(0).AddItem "Nu" MsgBox "Chao Cac Bạn" End With
End Sub
Public Sub KiemTraNgay(dong As String) Dim ok
Dim i As Integer With frmhosocb
If Len(dong) <> 10 Then
MsgBox "Bạn Nhập sai DL ngày tháng rồi! Hãy Nhập lại như sau: dd/mm/yyyy", vbCritical, "Chú ý"
.txthoso(2).SetFocus ok = False
End If
nam1 = Val(Mid(dong, 7, 5))
dong = Format(dong, "dd/mm/yyyy") Ngay = Val(Mid(dong, 1, 2))
Thang = Val(Mid(dong, 4, 2)) Nam = Val(Mid(dong, 7, 4)) Select Case Thang
Case 4, 6, 9, 11
If Ngay > 30 And Len(nam1) = 4 Then
MsgBox "Bạn nhập sai ngày, tháng này chỉ có 30 ngày!", vbCritical, "Chú ý"
.txthoso(2).SetFocus Else
If (Thang = 4) Or (Thang = 6) Or (Thang = 9) Or (Thang = 11) And (Len(nam1) = 4) Then .cbohoso(0).SetFocus ok = True End If End If Case 1, 3, 5, 7, 8, 10, 12
If Ngay > 31 And Len(nam1) = 4 Then
MsgBox "Bạn nhập sai ngày, tháng này chỉ có 31 ngày!", vbCritical, "Chú ý"
.txthoso(2).SetFocus Else
If (Thang = 1) Or (Thang = 3) Or (Thang = 5) Or (Thang = 7) Or (Thang = 8) Or (Thang = 10) Or (Thang = 12) And (Len(nam1) = 4) Then .cbohoso(0).SetFocus ok = True End If End If Case 2
MsgBox "Bạn nhập sai DL, tháng 2 chỉ có 28 ngày", vbCritical, "Chú ý"
.txthoso(2).SetFocus Else
If (Nam Mod 4 = 0) And (Ngay <= 29) And (Thang = 2) Then .cbohoso(0).SetFocus
ok = True End If
If (Nam Mod 4 <> 0) And (Ngay > 28) And (Thang = 2) Then MsgBox "Bạn nhập sai DL, tháng 2 chỉ có 28 ngày", vbCritical, "Chú ý"
.txthoso(2).SetFocus Else
If (Nam Mod 4 <> 0) And (Ngay <= 28) And (Thang = 2) Then ok = True .txthoso(2).SetFocus End If End If End If Case Else
If Val((Thang > 12) And (Len(nam1) = 4)) Then
MsgBox "Bạn Nhập sai kiểu tháng !", vbCritical, "Chú ý" .txthoso(2).SetFocus End If End Select If ok = True Then frmhosocb.cbohoso(0).SetFocus Else .txthoso(2).SetFocus MsgBox "xay ra o Toi" End If
End With End Sub
Dim myPathhoso As String Dim db As Database Dim rec As Recordset Dim mypath As String Dim dongsql As String Dim coghi
Private Sub cbohoso_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case Index Case 0 ' Gioi tinh
If KeyCode = 13 Then
If cbohoso(0).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" cbohoso(0).SetFocus
Else
If (UCase(Trim(cbohoso(0).Text)) = UCase("Nam")) Or (UCase(Trim((cbohoso(0).Text))) = UCase("Nữ")) Then
cbohoso(1).SetFocus Else
MsgBox "DL chỉ nhận là : Nam hoặc Nữ ", vbCritical, "Thông Báo" cbohoso(0).SetFocus End If End If End If Case 1 'Dân Tộc If KeyCode = 13 Then If cbohoso(1).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" cbohoso(1).SetFocus Else cbohoso(1).Text = Chuan(cbohoso(1), 2) txthoso(3).SetFocus End If End If Case 2 ' Phong If KeyCode = 13 Then If cbohoso(2).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" cbohoso(2).SetFocus Else cbohoso(2).Text = Chuan(cbohoso(2), 1) cbohoso(3).SetFocus End If End If Case 3 'Chuc vu If KeyCode = 13 Then If cbohoso(3).Text = "" Then
cbohoso(3).SetFocus Else cbohoso(3).Text = Chuan(cbohoso(3), 2) cbohoso(4).SetFocus End If End If Case 4 ' trinh Do If KeyCode = 13 Then If cbohoso(4).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" cbohoso(4).SetFocus Else cbohoso(4).Text = Chuan(cbohoso(4), 2) cbohoso(5).SetFocus End If End If
Case 5 ' Chuyen mon If KeyCode = 13 Then
If cbohoso(5).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" cbohoso(5).SetFocus Else cbohoso(5).Text = Chuan(cbohoso(5), 2) txthoso(5).SetFocus End If End If End Select End Sub
Sub cmdchucnang_Click(Index As Integer) Select Case Index
Case 0 ' Nhập mới
'MsgBox " Bạn vừa chọn nhập mới " Set db = OpenDatabase(mypath)
Set rec = db.OpenRecordset("hosocanbo") For i = 0 To 5 txthoso(i).Text = "" Next i For i = 0 To 5 cbohoso(i).Text = "" Next i NapNhapHSCB txthoso(0).SetFocus
Case 1 ' chọn chức năng sửa
IDMacb = InputBox(" Nhập vào mã Cán bộ cần sửa ", "Sửa chữa") If Len(Trim(IDMacb)) = 0 Then Exit Sub
Set rec = db.OpenRecordset("SELECT * FROM HosoCanBo WHERE [MaCB]='" & IDMacb & "'")
If rec.RecordCount = 0 Then
MsgBox "Không tồn tại mã cán bộ đó trong lưu trữ ", vbCritical, "Không thấy"
txthoso(0).SetFocus Exit Sub
End If
Set dathoso.Recordset = rec Me.dathoso.Refresh
On Error Resume Next Case 2 ' chọn chức năng Ghi MsgBox " Bạn vừa chọn ghi"
Set db = DBEngine.Workspaces(0).OpenDatabase(mypath) Set rec = db.OpenRecordset("HoSoCanBo")
' Kiểm tra Xem Da co đủ Thong tin For k = 0 To 5 If cbohoso(i).Text = "" Then cbohoso(i).SetFocus End If If txthoso(i).Text = "" Then txthoso(i).SetFocus End If Next k
dongsql = "Insert into hosocanbo
(macb,Hoten,ngaysinh,Gioitinh,DanToc,Quequan,NoiOhiennay,Phong,ChucV u,TrinhDo,Chuyenmon,NgayvaoBienChe) Values ('" &
UCase(Trim(txthoso(0).Text)) & "','" & Trim(txthoso(1).Text) & "','" & Trim(txthoso(2).Text) & "','" & Trim(cbohoso(0).Text) & "','" &
Trim(cbohoso(1).Text) & "','" & Trim(txthoso(3).Text) & "','" & Trim(txthoso(4).Text) & "','" & Trim(cbohoso(2).Text) & "','" & Trim(cbohoso(3).Text) & "','" & Trim(cbohoso(4).Text) & "','" & Trim(cbohoso(5).Text) & "','" & Trim(txthoso(5).Text) & "')" Me.dathoso.Recordset.MoveFirst For j = 0 To dathoso.Recordset.RecordCount - 1 If UCase(Trim(txthoso(0).Text)) <> UCase(dathoso.Recordset.Fields(0).Value) Then coghi = True Else
coghi = False
If coghi = False Then
MsgBox " Đã Có trong cơ sở dữ liệu của bạn !" Exit For End If End If Me.dathoso.Recordset.MoveNext Next j
If coghi = True Then db.Execute dongsql dathoso.Refresh End If
db.Execute dongsql
db.Execute "Insert Into Luong(macb,luong,kynhan)Values ('" & UCase(Trim(txthoso(0).Text)) & "',100,'No')"
db.Close
txthoso(0).SetFocus Case 3 'Xoá
Set db = OpenDatabase(mypath)
Set rec = db.OpenRecordset("Hosocanbo") With rec
If Not .EOF Or Not .BOF Then
xoa = MsgBox("Bạn Muốn xoá ?", vbYesNo, "Chú ý") If xoa = vbYes Then
Me.dathoso.Recordset.MoveFirst .Delete End If ' .Update End If End With Case 4, Xem frmXemhoso.Show Case 5 ' In ấn frmXemhoso.cmdchucnang_Click Case 6 'Kết Thúc Unload Me End Select End Sub
Private Sub dathoso_Reposition()
dongxoa = Me.dathoso.Recordset.RecordCount + 1 End Sub
Private Sub DBGrid1_Click()
If Not Me.dathoso.Recordset.BOF Or Not Me.dathoso.Recordset.EOF Then txthoso(0).Text = Me.dathoso.Recordset.Fields(0).Value
txthoso(1).Text = Me.dathoso.Recordset.Fields(1).Value Else
MsgBox "Đây la quá bản ghi cuối rồi", vbCritical, "Chú ý" End If
End Sub
Sub Form_Activate() Me.Width = 11100 Me.Height = 7500
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 20 End Sub
Private Sub Form_Load()
mypath = "c:\qlluong\QLLuong.mdb" Form_Activate For i = 0 To 5 txthoso(i).Text = "" Next i For i = 0 To 5 cbohoso(i).Text = "" Next i Me.NapNhapHSCB HienData End Sub
Private Sub txthoso_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case Index Case 0 ' ma Can Bo
If KeyCode = 13 Then
If txthoso(0).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" txthoso(0).SetFocus Else txthoso(0).Text = Chuan(txthoso(0), 3) txthoso(1).SetFocus End If End If Case 1 'Ho Ten
If KeyCode = 13 Then
If txthoso(0).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" txthoso(1).SetFocus
Else
txthoso(1).Text = Chuan(txthoso(1), 1) txthoso(2).SetFocus
End If End If Case 2 'Ngay sinh
If KeyCode = 13 Then
If txthoso(2).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" txthoso(2).SetFocus Else cbohoso(0).SetFocus End If KiemTraNgay (Trim(txthoso(2).Text)) End If
Case 3 ' Que quan
If KeyCode = 13 Then
If txthoso(3).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" txthoso(3).SetFocus Else txthoso(3).Text = Chuan(txthoso(3), 1) txthoso(4).SetFocus End If End If Case 4 'noi O If KeyCode = 13 Then If txthoso(4).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" txthoso(4).SetFocus Else txthoso(4).Text = Chuan(txthoso(4), 1) cbohoso(2).SetFocus End If End If Case 5 If KeyCode = 13 Then If txthoso(5).Text = "" Then
MsgBox "Bạn Phải nhập DL Vao !" txthoso(5).SetFocus
Else
If KiemTraNgayvaoBC(Trim(txthoso(5).Text)) = True Then cmdchucnang_Click (2) cmdchucnang_Click (0) Else Me.txthoso(5).SetFocus End If End If End If End Select End Sub
Public Sub HienData()
dathoso.DatabaseName = mypath dathoso.RecordSource = "Hosocanbo" End Sub
Public Sub NapNhapHSCB() With frmhosocb.cbohoso(0) .AddItem "Nam" .AddItem "Nữ" End With ' Nạp Dân Tộc Set db = DBEngine.Workspaces(0).OpenDatabase(mypath) MySql = "SELECT DISTINCT [DanToc] FROM HosoCanBo" Set rec = db.OpenRecordset(MySql, dbOpenSnapshot)
If rec.RecordCount <> 0 Then With rec
.MoveLast .MoveFirst
Do While Not .EOF
frmhosocb.cbohoso(1).AddItem (.Fields(0).Value) .MoveNext Loop End With End If 'Nap Phòng Ban Set db = DBEngine.Workspaces(0).OpenDatabase(mypath) MySql = "SELECT DISTINCT [Phong] FROM HosoCanBo" Set rec = db.OpenRecordset(MySql, dbOpenSnapshot) If rec.RecordCount <> 0 Then
With rec
.MoveLast .MoveFirst
Do While Not .EOF frmhosocb.cbohoso(2).AddItem (.Fields(0).Value) .MoveNext Loop End With End If Set db = DBEngine.Workspaces(0).OpenDatabase(mypath) MySql = "SELECT DISTINCT [ChucVu] FROM HosoCanBo" Set rec = db.OpenRecordset(MySql, dbOpenSnapshot) If rec.RecordCount <> 0 Then
With rec
.MoveLast .MoveFirst
Do While Not .EOF
frmhosocb.cbohoso(3).AddItem (.Fields(0).Value) .MoveNext
Loop End With End If 'Nap Trinh Dô
Set db = DBEngine.Workspaces(0).OpenDatabase(mypath) MySql = "SELECT DISTINCT [TrinhDO] FROM HosoCanBo" Set rec = db.OpenRecordset(MySql, dbOpenSnapshot)
If rec.RecordCount <> 0 Then With rec
.MoveLast .MoveFirst
Do While Not .EOF
frmhosocb.cbohoso(4).AddItem (.Fields(0).Value) .MoveNext
Loop End With End If 'Nap Chuyen Mon
Set db = DBEngine.Workspaces(0).OpenDatabase(mypath)
MySql = "SELECT DISTINCT [ChuyenMon] FROM HosoCanBo" Set rec = db.OpenRecordset(MySql, dbOpenSnapshot)
If rec.RecordCount <> 0 Then With rec
.MoveLast .MoveFirst
Do While Not .EOF
.MoveNext Loop
End With End If End Sub
Sub Nhaplai(dk As Boolean) If dk = True Then txthoso(2).SetFocus Else cbohoso(1).SetFocus End If End Sub
Public Function KiemTraNgayvaoBC(dong As String) As Boolean Dim ok
Dim i As Integer With frmhosocb
If Len(dong) <> 10 Then
MsgBox "Bạn Nhập sai DL ngày tháng rồi! Hãy Nhập lại như sau: dd/mm/yyyy", vbCritical, "Chú ý"
.txthoso(5).SetFocus ok = False
End If
nam1 = Val(Mid(dong, 7, 5))
dong = Format(dong, "dd/mm/yyyy") Ngay = Val(Mid(dong, 1, 2))
Thang = Val(Mid(dong, 4, 2)) Nam = Val(Mid(dong, 7, 4))
Select Case Thang Case 4, 6, 9, 11
If Ngay > 30 And Len(nam1) = 4 Then
MsgBox "Bạn nhập sai ngày, tháng này chỉ có 30 ngày!", vbCritical, "Chú ý"
.txthoso(5).SetFocus Else
If (Thang = 4) Or (Thang = 6) Or (Thang = 9) Or (Thang = 11) And (Len(nam1) = 4) Then .txthoso(0).SetFocus ok = False End If End If
Case 1, 3, 5, 7, 8, 10, 12
If Ngay > 31 And Len(nam1) = 4 Then
MsgBox "Bạn nhập sai ngày, tháng này chỉ có 31 ngày!", vbCritical, "Chú ý"
.txthoso(5).SetFocus Else
If (Thang = 1) Or (Thang = 3) Or (Thang = 5) Or (Thang = 7) Or (Thang = 8) Or (Thang = 10) Or (Thang = 12) And (Len(nam1) = 4) Then .txthoso(0).SetFocus ok = True End If End If Case 2
If (Nam Mod 4 = 0) And (Ngay > 29) And (Thang = 2) Then
MsgBox "Bạn nhập sai DL, tháng 2 chỉ có 28 ngày", vbCritical, "Chú ý"
.txthoso(5).SetFocus Else
If (Nam Mod 4 = 0) And (Ngay <= 29) And (Thang = 2) Then .txthoso(5).SetFocus
ok = True End If
If (Nam Mod 4 <> 0) And (Ngay > 28) And (Thang = 2) Then MsgBox "Bạn nhập sai DL, tháng 2 chỉ có 28 ngày", vbCritical, "Chú ý"