Cài đặt và chạy chương trỡnh

Một phần của tài liệu Đề tài quản lý lao động và tiền lương trên microsoft access (Trang 40)

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ú ý"

Một phần của tài liệu Đề tài quản lý lao động và tiền lương trên microsoft access (Trang 40)

Tải bản đầy đủ (PDF)

(86 trang)