Đồ án Công nghệ thông tin: Quản lý tài sản cố định

sDat.MoveNext rsDat0.MoveNext Wend rsTS.MoveFirst While rsTS!MaTS MaTS rsTS.MoveNext Wend Set rsPh = New ADODB.Recordset rsPh.Open "Select * from tblPhieu where tblPhieu!MaPhieu ='" & rsDat0!Maphieu & "' ;", cnn, adOpenDynamic, adLockOptimistic Set rsNhom = New ADODB.Recordset rsNhom.Open "Select * from tblNhom where tblNhom!Manhom ='" & rsTS!MaNhom & "' ;", cnn, adOpenDynamic, adLockOptimistic txtDiachi.Text = rsDat!diachits txtNgayLP.Text = Format(rsPh!NgayLP, "dd/mm/yyyy") txtTenNLP.Text = rsPh!TenNLP txtDienTichTKT.Text = rsDat!DientichKT txtDientichTTT.Text = rsDat!DientichTT txtGiaTriTT.Text = rsDat!GiatriTT txtGiayCN.Text = rsDat!GiayCN txtKoGiayCN.Text = rsDat!KoGiayCN txtChiphiKT.Text = rsDat!ChiphiKT txtTang.Text = rsDat!Tang txtGiam.Text = rsDat!Giam txtCSD.Text = rsDat!CSD txtXaydungnha.Text = rsDat!Xaydungnha txtMDC.Text = rsDat!MDC txtSDMDK.Text = rsDat!SDMDK txtDichvu.Text = rsDat!Dichvu txtThue.Text = rsDat!Thue txtChia.Text = rsDat!Chia txtGiatriCN.Text = rsDat!GiatriCN txtGiatriCCN.Text = rsDat!GiatriCCN txtTenTS = rsTS!TenTS txtSudung.Text = rsDat!Sudung txtMaphieu.Text = rsPh!Maphieu txtDongia.Text = rsNhom!Dongia nhom = rsNhom!MaNhom End If Set rsNhom = New ADODB.Recordset rsNhom.Open "Select * from tblNhom where tblnhom!MaloaiTS = '001' ;", cnn, adOpenDynamic, adLockOptimistic With rsDV If .EOF And .BOF Then .AddNew Else .MoveFirst While .EOF = False If rsDV!MaDV = MaDV Then txtTenDV.Text = rsDV!TenDV End If .MoveNext Wend End If End With If Dat = 1 Then txtMaphieu = TangCode(CodeP, 5) Dim i As Integer cboNhomDat.Clear i = 0 With rsNhom If Not (.EOF And .BOF) Then .MoveFirst While .EOF = False cboNhomDat.AddItem !tennhom Dongia(i) = !Dongia MaNhom(i) = !MaNhom i = i + 1 .MoveNext Wend End If End With If cboNhomDat.ListCount > 0 Then For i = 0 To cboNhomDat.ListCount - 1 If MaNhom(i) = nhom Then cboNhomDat.ListIndex = i Next End If End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Mre Me End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = 0 Then cmdThoat_Click End Sub Private Sub Mybutton1_Click() cmdGhiDL_Click End Sub Private Sub Mybutton2_Click() cmdNhaplai_Click End Sub Private Sub Mybutton3_Click() cmdNhapMoi_Click End Sub Private Sub Mybutton4_Click() cmdThoat_Click End Sub Private Sub Text3_Change() End Sub Private Sub Timer1_Timer() 'nut ghi du lieu On Error Resume Next Dim c As Control Dim ok As Boolean ok = True For Each c In Me.Controls If TypeOf c Is TextBox Or TypeOf c Is ComboBox Then If c.Text = "" Then ok = False End If Next If ok Then cmdGhiDL.Enabled = True Else cmdGhiDL.Enabled = False End If ' tinh don gia cua cac loai gia tri If cboNhomDat.ListIndex -1 Then txtDongia = Dongia(cboNhomDat.ListIndex) If txtDientichTTT "" Then txtGiaTriTT.Text = Val(txtDientichTTT.Text) * Val(txtDongia.Text) Else txtGiaTriTT.Text = "" End If If txtDienTichTKT "" Then txtChiphiKT.Text = Val(txtDienTichTKT.Text) * Val(txtDongia.Text) Else txtChiphiKT.Text = "" End If If txtGiayCN "" Then txtGiatriCN = Val(txtGiayCN.Text) * Val(txtDongia.Text) Else txtGiatriCN.Text = "" End If If txtKoGiayCN "" Then txtGiatriCCN.Text = Val(txtKoGiayCN.Text) * Val(txtDongia.Text) Else txtGiatriCCN.Text = "" End If End If 'tinh dien tich xay dung nha If txtXaydungnha.Text "" Then txtSudung.Text = Val(txtDientichTTT.Text) - Val(txtXaydungnha.Text) Else txtSudung.Text = "" End If 'tinh dien tich tang giam If txtDienTichTKT.Text "" Then Dim i As Variant i = Val(txtDientichTTT.Text) - Val(txtDienTichTKT.Text) If i > 0 Then txtTang.Text = i txtGiam.Text = 0 ElseIf i < 0 Then txtGiam.Text = -i txtTang.Text = 0 ElseIf i = 0 Then txtTang.Text = i txtGiam.Text = i End If End If 'xet dieu kien cua txtdientichttt If Val(txtDientichTTT.Text) < Val(txtXaydungnha.Text) Then txtDientichTTT.Text = "" txtDientichTTT.SetFocus txtXaydungnha.Text = "" End If If txtDientichTTT.Text = "" Then txtXaydungnha.Text = "" txtSudung.Text = "" txtTang.Text = "" txtGiam.Text = "" txtMDC.Text = "" txtGiayCN.Text = "" txtSDMDK.Text = "" 'xet dieu kien dien tich txtSDMDK If Dat = 0 Then If Val(txtSDMDK.Text) - Val(txtDichvu.Text) < Val(txtThue.Text) Then txtDichvu.Text = "" txtDichvu.SetFocus txtThue.Text = "" txtChia.Text = "" End If End If End If ' xet dieu kien txtMDC If Val(txtMDC.Text) > Val(txtDientichTTT.Text) Then txtMDC.SetFocus txtMDC.Text = "" txtSDMDK.Text = "" txtDichvu.Text = "" txtChia.Text = "" txtThue.Text = "" txtCSD.Text = "" End If If txtMDC.Text = "" Then txtSDMDK.Text = "" txtDichvu.Text = "" txtThue.Text = "" txtChia.Text = "" txtCSD.Text = "" End If ' tinh dien tich dich vu, thue, chia If txtDichvu.Text "" Then If Val(txtDichvu.Text) = Val(txtSDMDK.Text) Then txtThue.Text = 0 txtThue.Enabled = False txtChia.Text = 0 End If End If If txtThue "" Then If txtThue.Text < Val(txtSDMDK.Text) - Val(txtDichvu.Text) Then txtChia.Text = Val(txtSDMDK.Text) - Val(txtDichvu.Text) - Val(txtThue.Text) End If If txtThue.Text > Val(txtSDMDK.Text) - Val(txtDichvu.Text) Then txtThue.SetFocus txtThue.Text = "" End If If Val(txtThue.Text) + Val(txtDichvu.Text) = Val(txtSDMDK.Text) Then txtChia.Text = 0 End If End If End Sub Private Sub txtChia_GotFocus() CEmpty txtMDC End Sub Private Sub txtChia_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtChiphiKT_Click() cmdNhaplai.Enabled = True Mybutton2.Enabled = True End Sub Private Sub txtChiphiKT_GotFocus() CEmpty txtDienTichTKT End Sub Private Sub txtChiphiKT_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtCSD_GotFocus() CEmpty txtMDC End Sub Private Sub txtCSD_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtDiachi_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtDiaChi_GotFocus() CEmpty txtTenTS Hien " NhËp ®Þa chØ khu ®Êt vµo ®©y" End Sub Private Sub txtDichvu_Change() If txtDichvu.Text = "" Then txtChia.Text = "" txtThue.Text = "" End If If Val(txtDichvu.Text) > Val(txtSDMDK.Text) Then txtDichvu.SetFocus txtDichvu.Text = "" txtThue.Text = "" End If txtChia.Enabled = True txtThue.Enabled = True End Sub Private Sub txtDichvu_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtDichvu_GotFocus() CEmpty txtSDMDK Hien " NhËp diÖn tÝch ®Êt ®ang dïng cho s¶n xuÊt vµ kinh doanh ( chØ nhËp sè ) ko lín h¬n sö dông môc ®Ých kh¸c " End Sub Private Sub txtDientichCSD_Click() cmdNhaplai.Enabled = True Mybutton2.Enabled = True End Sub Private Sub txtDientichCSD_GotFocus() CEmpty txtNgayLP End Sub Private Sub txtDientichCSD_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtDienTichTKT_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtDienTichTKT_GotFocus() CEmpty txtGiaTriTT Hien " NhËp diÖn tÝch theo sæ kÕ to¸n vµo ®©y ( chØ nhËp sè )" End Sub Private Sub txtDienTichTKT_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtDienTichTKT_LostFocus() If SSTab1.Tab = 0 Then SSTab1.Tab = 1 End Sub Private Sub txtDientichTTT_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtDientichTTT_GotFocus() Hien " Nh¹p diÖn tÝch t¹i thêi ®iÓm kiÓm kª ( chØ nhËp sè ) " txtSDMDK.Enabled = True txtCSD.Enabled = True CEmpty txtDongia End Sub Private Sub txtDientichTTT_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtdungsx_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtDongia_GotFocus() CEmpty cboNhomDat txtGiaTriTT.Enabled = True End Sub Private Sub txtGiam_Click() cmdNhaplai.Enabled = True Mybutton2.Enabled = True End Sub Private Sub txtGiam_GotFocus() CEmpty txtTang End Sub Private Sub txtGiam_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtGiamCD_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtGiatriCCN_GotFocus() CEmpty txtKoGiayCN End Sub Private Sub txtGiatriCCN_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtGiatriCN_GotFocus() CEmpty txtGiayCN End Sub Private Sub txtGiatriCN_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtGiaTriTT_GotFocus() CEmpty txtXaydungnha End Sub Private Sub txtGiatriTT_KeyPress(KeyAscii As Integer) SubKeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtGiayCN_Change() If txtGiayCN.Text "" Then txtKoGiayCN.Text = Val(txtDientichTTT.Text) - Val(txtGiayCN.Text) Else txtKoGiayCN.Text = "" End If If Val(txtGiayCN.Text) > Val(txtDientichTTT.Text) Then txtGiayCN.SetFocus txtGiayCN.Text = "" End If End Sub Private Sub txtGiayCN_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtGiayCN_GotFocus() CEmpty txtCSD Hien " NhËp diÖn tÝch ch­a cã giÊy chøng nhËn quyÒn sö dông ®Êt ( chØ nhËp sè ) ko ®­îc lín h¬n tæng diÖn tÝch ®Êt " End Sub Private Sub txtGiayCN_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtKoGiayCN_GotFocus() CEmpty txtGiatriCN End Sub Private Sub txtKoGiayCN_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtMDC_Change() txtSDMDK.Enabled = True txtCSD.Enabled = True If Val(txtMDC.Text) = Val(txtDientichTTT.Text) Then txtSDMDK.Text = "0" txtSDMDK.Enabled = False txtCSD.Text = "0" txtCSD.Enabled = False txtDichvu.Enabled = False txtChia.Enabled = False txtThue.Enabled = False End If End Sub Private Sub txtMDC_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtMDC_GotFocus() Hien " NhËp diÖn tÝch sö dông cho môc ®Ých chÝnh ( chØ nhËp sè )" CEmpty txtDongia End Sub Private Sub txtMDC_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtNgayLP_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtNgayLP_GotFocus() CEmpty txtTenNLP Hien " B¹n cÇn nhËp ngµy vµo _/_/_/" End Sub Private Sub txtNgayLP_Validate(Cancel As Boolean) If Not IsDate(txtNgayLP) Then txtNgayLP.SetFocus txtNgayLP.Text = "" Cancel = True ElseIf DateValue(txtNgayLP) > Now() Or DateValue(txtNgayLP) < DateValue(Format("01/01/1998", "dd/mm/yyyy")) Then txtNgayLP.SetFocus txtNgayLP.Text = "" Cancel = True Else: txtNgayLP = Format(txtNgayLP, "dd/mm/yyyy") End If End Sub Private Sub txtQuan_Click() cmdNhaplai.Enabled = True Mybutton2.Enabled = True End Sub Private Sub txtQuan_GotFocus() CEmpty txtDiachi End Sub Private Sub txtSDMDK_Change() If Val(txtSDMDK.Text) = 0 Then txtDichvu.Text = 0 txtThue.Text = 0 txtChia.Text = 0 End If If txtSDMDK.Text "" Then If Val(txtSDMDK.Text) = Val(txtDientichTTT.Text) - Val(txtMDC.Text) Then txtCSD.Text = 0 txtCSD.Enabled = False ElseIf Val(txtSDMDK.Text) < Val(txtDientichTTT.Text) - Val(txtMDC.Text) Then txtCSD.Text = Val(txtDientichTTT.Text) - Val(txtMDC.Text) - Val(txtSDMDK.Text) txtCSD.Enabled = False ElseIf Val(txtSDMDK.Text) > Val(txtDientichTTT.Text) - Val(txtMDC.Text) Then txtSDMDK.SetFocus txtSDMDK.Text = "" txtThue.Text = "" txtDichvu.Text = "" txtChia.Text = "" End If Else txtSDMDK.Text = "" txtThue.Text = "" txtDichvu.Text = "" txtChia.Text = "" txtCSD.Text = "" End If End Sub Private Sub txtSDMDK_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtSDMDK_GotFocus() Hien " NhËp diÖn tÝch sö dung cho môc ®Ých kh¸c ( chØ nhËp sè )" txtCSD.Enabled = True CEmpty txtMDC txtChia.Enabled = True End Sub Private Sub txtSDMDK_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtSudung_Click() cmdNhaplai.Enabled = True Mybutton2.Enabled = True End Sub Private Sub txtSudung_GotFocus() CEmpty txtXaydungnha Hien " NhËp diÖn mtÝch ®É x©y dùng c«ng tr×nh vËt kiÕn tróc( chØ nhËp sè)" End Sub Private Sub txtSudung_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtTang_Click() cmdNhaplai.Enabled = True Mybutton2.Enabled = True End Sub Private Sub txtTang_GotFocus() CEmpty txtChiphiKT End Sub Private Sub txtTang_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtTenNLP_Change() If txtTenNLP.Text "" Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtTenNLP_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtTenNLP_GotFocus() Hien "B¹n cÇn nhËp lµ ch÷ vµo ®©y" End Sub Private Sub txtTenNLP_KeyPress(KeyAscii As Integer) KeyAscii = Char_Check(KeyAscii) End Sub Private Sub txtTenTS_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtTenTS_GotFocus() CEmpty txtNgayLP Hien " NhËp tªn ®¬n vÞ vµo ®©y" End Sub Private Sub txtThue_Change() If txtThue.Text = "" Then txtChia.Text = "" End If If Val(txtThue.Text) > Val(txtSDMDK.Text) - Val(txtDichvu.Text) Then txtThue.SetFocus txtThue.Text = "" txtChia.Text = "" End If End Sub Private Sub txtThue_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtThue_GotFocus() Hien " NhËp diÖn tÝch ®©ng dïng cho thuª ( chØ nhËp sè ) diÖn tÝch ko ®­îc lín h¬n (sö dông cho môc ®Ých kh¸c - ®ang dïng cho s¶n xuÊt kinh doanh.)" CEmpty txtSDMDK txtChia.Enabled = True End Sub Private Sub txtThue_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtXaydungnha_Change() If Val(txtXaydungnha.Text) > Val(txtDientichTTT.Text) Then txtXaydungnha.SetFocus txtXaydungnha.Text = "" txtSudung.Text = "" End If End Sub Private Sub txtXaydungnha_Click() If Dat = 0 Then cmdNhaplai.Enabled = True Mybutton2.Enabled = True End If End Sub Private Sub txtXaydungnha_GotFocus() Hien " NhËp diÖn tÝch ®· dïng ®Ó x©y dùng nhµ ( chØ nhËp sè ) ko ®­îc lín h¬n tæng diÖn tÝch ®Êt " txtSudung.Enabled = True CEmpty txtDientichTTT End Sub Private Sub txtXaydungnha_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub 1.4 Form : frmGiaoDich Dim rsDVA As ADODB.Recordset Dim rsDVB As ADODB.Recordset Dim rsDVN As ADODB.Recordset Dim rsTSD As ADODB.Recordset Dim rsTSKD As ADODB.Recordset Private rs As ADODB.Recordset Public mo As Integer Dim benA As String Dim benB As String Dim TS As String Dim DVN As String Const sql = "Select tblDonvi.MaDV, tblDonvi.TenDV from tblDonvi " Dim sqlTSD As String Dim sqlTSKD As String Dim i As Integer Dim CodeTS(100) As String Dim bA(100) As String Dim bB(100) As String Dim a As Integer Dim d As Integer Dim soluong(100) As Integer Private Sub cboBenA_GotFocus() Dim i As Integer Dim j As Integer cboBenA.Clear i = 0 Set rsDVA = New ADODB.Recordset rsDVA.Open sql, cnn, adOpenDynamic, adLockBatchOptimistic rsDVA.MoveFirst While Not rsDVA.EOF If rsDVA!TenDV benB Then cboBenA.AddItem rsDVA!TenDV If rsDVA!MaDV = MaDV Then j = i bA(i) = rsDVA!MaDV i = i + 1 End If rsDVA.MoveNext Wend rsDVA.Close Set rsDVA = Nothing cboBenA.ListIndex = j Me.Refresh End Sub Private Sub cboBenA_LostFocus() benA = cboBenA End Sub Private Sub cboBenB_Gotfocus() Dim i As Integer cboBenB.Clear Set rsDVB = New ADODB.Recordset rsDVB.Open sql, cnn, adOpenDynamic, adLockBatchOptimistic rsDVB.MoveFirst While Not rsDVB.EOF If rsDVB!TenDV benA Then cboBenB.AddItem rsDVB!TenDV bB(i) = rsDVB!MaDV i = i + 1 End If rsDVB.MoveNext Wend rsDVB.Close Set rsDVB = Nothing End Sub Private Sub cboBenB_LostFocus() benB = cboBenB End Sub Private Sub cboDVN_Lostfocus() DVN = cboDVN End Sub Private Sub cboTS_GotFocus() Dim i As Integer cboTS.Clear Set rsTSD = New ADODB.Recordset Set rsTSKD = New ADODB.Recordset i = 0 Select Case cboSort.ListIndex Case 1, 3: If benA "" Then a = 0 qryTSD = "SELECT tblDonVi.TenDV, tblLoaiTS_Detail.* " _ & "FROM (tblTongHopDat_Master INNER JOIN tblDonVi ON tblTongHopDat_Master.MaDV = tblDonVi.MaDV) INNER JOIN tblLoaiTS_Detail ON tblTongHopDat_Master.MaTS = tblLoaiTS_Detail.MaTS " _ & "Where tblDonVi.TenDV ='" & benA & "';" qryTSKD = "SELECT tblDonVi.TenDV, tblLoaiTS_Detail.* " _ & "FROM (tblLoaiTS_Detail INNER JOIN tblTongHopTSCD_KLD_Master ON tblLoaiTS_Detail.MaTS = tblTongHopTSCD_KLD_Master.MaTS) INNER JOIN tblDonVi ON tblTongHopTSCD_KLD_Master.MaDV = tblDonVi.MaDV " _ & "Where tblDonvi.tenDV ='" & benA & "';" End If Case 0, 2: a = 1 If benB "" And cboBenB.Enabled Then qryTSD = "SELECT tblDonVi.TenDV, tblLoaiTS_Detail.* " _ & "FROM (tblTongHopDat_Master INNER JOIN tblDonVi ON tblTongHopDat_Master.MaDV = tblDonVi.MaDV) INNER JOIN tblLoaiTS_Detail ON tblTongHopDat_Master.MaTS = tblLoaiTS_Detail.MaTS " _ & "Where tblDonVi.TenDV ='" & benB & "';" qryTSKD = "SELECT tblDonVi.TenDV, tblLoaiTS_Detail.* " _ & "FROM (tblLoaiTS_Detail INNER JOIN tblTongHopTSCD_KLD_Master ON tblLoaiTS_Detail.MaTS = tblTongHopTSCD_KLD_Master.MaTS) INNER JOIN tblDonVi ON tblTongHopTSCD_KLD_Master.MaDV = tblDonVi.MaDV " _ & "Where tblDonvi.tenDV ='" & benB & "';" End If End Select If qryTSD "" And qryTSKD "" Then rsTSD.Open qryTSD, cnn, adOpenDynamic, adLockOptimistic rsTSKD.Open qryTSKD, cnn, adOpenDynamic, adLockOptimistic While Not rsTSD.EOF cboTS.AddItem rsTSD!TenTS CodeTS(i) = rsTSD!MaTS i = i + 1 rsTSD.MoveNext Wend While Not rsTSKD.EOF cboTS.AddItem rsTSKD!TenTS CodeTS(i) = rsTSKD!MaTS i = i + 1 rsTSKD.MoveNext Wend End If End Sub Private Sub cmdBenA_Click() Dim ok As Boolean ok = False Set rsDVA = New ADODB.Recordset rsDVA.Open sql, cnn, adOpenDynamic, adLockBatchOptimistic rsDVA.MoveFirst While Not rsDVA.EOF If rsDVA!TenDV = benA Then MaDV = rsDVA!MaDV ok = True End If rsDVA.MoveNext Wend rsDVA.Close Set rsDVA = Nothing If ok Then frmNhapDV.Show End Sub Private Sub CmdBenB_Click() Dim ok As Boolean ok = False Set rsDVB = New ADODB.Recordset rsDVB.Open sql, cnn, adOpenDynamic, adLockBatchOptimistic rsDVB.MoveFirst While Not rsDVB.EOF If rsDVB!TenDV = benB Then MaDV = rsDVB!MaDV ok = True End If rsDVB.MoveNext Wend rsDVB.Close Set rsDVB = Nothing If ok Then frmNhapDV.Show End Sub Private Sub CmdDVN_Click() Dim ok As Boolean ok = False Set rsDVN = New ADODB.Recordset rsDVN.Open "tblDVNgoai", cnn, adOpenDynamic, adLockBatchOptimistic rsDVN.MoveFirst While Not rsDVN.EOF If rsDVN!TenDVN = DVN Then MaDVN = rsDVN!MaDVN ok = True End If rsDVN.MoveNext Wend rsDVN.Close Set rsDVN = Nothing If ok Then frmNhapDV.Show End Sub Private Sub cmdExit_Click() If mo = 1 Then frmNhapDS.Show Child_Unload Me End Sub Private Sub cmdNew_Click() cmdReset_Click Form_Load End Sub Private Sub cmdReset_Click() Dim ctl As Control For Each ctl In Me.Controls If TypeOf ctl Is ComboBox And ctl.Name "cboSort" Then ctl.Clear If TypeOf ctl Is TextBox Then ctl.Text = "" 'If TypeOf ctl Is MaskEdBox Then ctl = "" Next End Sub Private Sub cmdSave_Click() Dim dk As String If a = 0 Then dk = bB(cboBenB.ListIndex) Else dk = bA(cboBenA.ListIndex) End If If Left(CodeTS(cboTS.ListIndex), 1) = "1" Then Set rsTSD = New ADODB.Recordset rsTSD.Open "select * from tblTongHopDat_Master where tblTongHopDat_Master.MaTS ='" & CodeTS(cboTS.ListIndex) & "' ;", cnn, adOpenDynamic, adLockOptimistic rsTSD!MaDV = dk rsTSD.Update Else Set rsTSKD = New ADODB.Recordset rsTSKD.Open "select * from tblTongHopTSCD_KLD_Master where tblTongHopTSCD_KLD_Master.MaTS ='" & CodeTS(cboTS.ListIndex) & "' ;", cnn, adOpenDynamic, adLockOptimistic rsTSKD!MaDV = dk rsTSKD.Update End If Dim rs As ADODB.Recordset Dim rs1 As ADODB.Recordset Dim rs2 As ADODB.Recordset Set rs = New ADODB.Recordset Set rs1 = New ADODB.Recordset Set rs2 = New ADODB.Recordset rs.Open "tblHopDong", cnn, adOpenDynamic, adLockOptimistic rs1.Open "tblHopDongbenA", cnn, adOpenDynamic, adLockOptimistic rs2.Open "tblHopDongbenB", cnn, adOpenDynamic, adLockOptimistic rs.AddNew rs1.AddNew rs2.AddNew rs!NgayHD = Text1.Text rs!LoaiHD = cboSort rs!MaTS = CodeTS(cboTS.ListIndex) rs1!benA = bA(cboBenA.ListIndex) rs2!benB = bB(cboBenB.ListIndex) rs.Update rs1!Mahd = rs!Mahd rs2!Mahd = rs!Mahd rs1.Update rs2.Update cmdReset_Click Form_Load End Sub Private Sub Form_Load() If mo 0 Then Unload frmNhapDS Child_Load Me cboDVN.Visible = False 'CmdDVN.Visible = False benA = "" benB = "" 'Add cac item cho cboSort cboSort.AddItem "Mua" cboSort.AddItem "B¸n" cboSort.AddItem "Thuª" cboSort.AddItem "Cho thuª" cboSort.ListIndex = 0 Set rsDVN = New ADODB.Recordset rsDVN.Open "tblDVNgoai", cnn, adOpenDynamic, adLockBatchOptimistic If Not (rsDVN.EOF And rsDVN.BOF) Then rsDVN.MoveFirst While Not rsDVN.EOF cboDVN.AddItem rsDVN!TenDVN rsDVN.MoveNext Wend rsDVN.Close Set rsDVN = Nothing End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Mre Me End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = 0 Then Child_Unload Me End Sub Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single) End Sub Private Sub Mybutton2_Click() cmdReset_Click End Sub Private Sub Mybutton3_Click() cmdReset_Click End Sub Private Sub Mybutton4_Click() cmdExit_Click End Sub Private Sub optBenB_Click() cboDVN.Visible = False CmdDVN.Visible = False cboBenB.Visible = True CmdBenB.Visible = True End Sub Private Sub optDVN_Click() cboDVN.Visible = True CmdDVN.Visible = True cboBenB.Visible = False CmdBenB.Visible = False End Sub Private Sub Text1_lostfocus() Dim dt As String dt = Text1.Text If Not Validdate(dt) Then Text1.SetFocus Text1.Text = "" Else Text1.Text = Format(dt, "dd/mm/yyyy") 'If Format(Text1.Text) > Format(Now()) Then ' Text1.SetFocus ' Text1.Text = "" ' End If End If End Sub Private Sub Timer1_Timer() Dim ctl As Control Dim ok As Boolean ok = True For Each ctl In Me.Controls If TypeOf ctl Is TextBox Then If ctl.Text = "" Then ok = False End If Next If cboBenA "" And (cboBenB "" Or cboDVN "") Then cboTS.Enabled = True 'cmdTS.Enabled = True Else cboTS.Enabled = False 'cmdTS.Enabled = False End If If cboTS "" And cboBenA "" And (cboBenB "" Or DVN "") _ And Text1.Text "" Then cmdSave.Enabled = True Else cmdSave.Enabled = False End If If txtDate "" Or cboTS "" Or benA "" Or (benB "" Or DVN "") _ Or Text1.Text "" Then cmdReset.Enabled = True Else cmdReset.Enabled = False End If End Sub 1.5 Form: frmChonTS Option Explicit Dim i As Integer Dim Li As ListItem Dim rsLoaiTS As ADODB.Recordset Dim rsNhom As ADODB.Recordset Dim MaLoai(6) As String Dim sSQL As String Private Sub cboLoai_Click() List.ListItems.Clear Call AddListItem(Li, TimMaLoai(cboLoai.Text)) End Sub Private Sub cmdSua_Click() iButton = Sua MaNhom = List.SelectedItem.ListSubItems(1).Text frmNhapTS.Show Child_Unload Me End Sub Private Sub cmdThem_Click() iButton = Them frmNhapTS.Show Child_Unload Me End Sub Private Sub cmdThoat_Click() Child_Unload Me End Sub Private Sub cmdXoa_Click() Dim ok As Boolean With rsNhom ok = False .MoveFirst While Not .EOF And Not ok If rsNhom!MaNhom = List.SelectedItem.ListSubItems(1).Text Then ok = True Else .MoveNext End If Wend .Delete If Not .EOF Then .MoveNext ElseIf Not .BOF Then .MovePrevious Else Hien "B¹n võa xo¸ nhãm tµi s¶n cuèi cïng" End If End With cmdXoa.Enabled = False Form_Load End Sub Private Sub Form_Load() Child_Load Me cboLoai.Clear Set rsLoaiTS = New ADODB.Recordset rsLoaiTS.Open "tblLoaits_master", cnn, adOpenDynamic, adLockOptimistic With rsLoaiTS i = 0 .MoveFirst While .EOF = False cboLoai.AddItem !TenloaiTS, i i = i + 1 .MoveNext Wend End With cboLoai.ListIndex = 0 End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = 0 Then Child_Unload Me End Sub Private Sub AddListItem(ByRef xItem As ListItem, s As String) Dim i As Integer sSQL = "SELECT * FROM tblnhom WHERE maloaits='" & s & "';" Set rsNhom = New ADODB.Recordset rsNhom.Open sSQL, cnn, adOpenDynamic, adLockOptimistic With rsNhom If .EOF And .BOF Then cmdSua.Enabled = False cmdXoa.Enabled = False Hien "Ch­a nhËp nhãm tµi s¶n" Else cmdSua.Enabled = True cmdXoa.Enabled = True .MoveFirst i = 1 While Not .EOF Set xItem = List.ListItems.Add xItem.Text = i xItem.ListSubItems.Add key:="M· nhãm", Text:=!MaNhom xItem.ListSubItems.Add key:="Tªn nhãm", Text:=!tennhom .MoveNext i = i + 1 Wend End If End With End Sub Function TimMaLoai(tenloai As String) Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset rs.Open "tblloaits_master", cnn, adOpenDynamic, adLockOptimistic With rs .MoveFirst While Not .EOF And tenloai !TenloaiTS .MoveNext Wend TimMaLoai = !MaloaiTS End With End Function 1.6 Form : frmNhapDV Option Explicit Dim rsDV As ADODB.Recordset Dim k As Integer Dim StopWh As Boolean Dim Temp As String Dim sSQL As String Private Sub cboCT_Click() txtMaDV.Enabled = True txtMaDV.Text = CodeDV(cboCT.Text) txtMaDV.Enabled = False txtTenDV.Enabled = True 'txtTenDV.SetFocus Check_Empty End Sub Private Sub cboQuan_Click() Check_Empty End Sub Private Sub cboQuan_GotFocus() 'CEmpty txtDiaChi Hien "QuËn theo ®Þa chØ cña ®¬n vÞ" End Sub Private Sub cboQuan_KeyPress(KeyAscii As Integer) If UCase(Chr(KeyAscii)) = "D" Then cboQuan.ListIndex = 1 End Sub Private Sub cmdCapnhat_Click() If CDublicate(txtTenDV.Text) Then MMsgbox "§· cã tªn ®¬n vÞ nµy råi, ®Ò nghÞ nhËp l¹i" Hien "§· cã tªn ®¬n vÞ nµy råi, ®Ò nghÞ nhËp l¹i" txtTenDV.Text = "" txtDiachi.Text = "" txtDT.Text = "" txtSoNV.Text = "" Exit Sub End If If iButton = 2 Then If MaDV = txtMaDV.Text Then GetValue rsDV.Update Else rsDV.Delete If Not rsDV.EOF Then rsDV.MoveNext ElseIf Not rsDV.BOF Then rsDV.MovePrevious End If rsDV.AddNew GetValue rsDV.Update ThemDVCD (cboCT.Text) Call DoiTS(MaDV, txtMaDV.Text) End If ElseIf iButton = 3 Then With rsDV rsDV.AddNew GetValue rsDV.Update End With ThemDVCD (cboCT.Text) cboCT.Refresh End If cmdThoat_Click End Sub Private Sub cmdThoat_Click() Child_Unload Me frmDonVi.Show End Sub Private Sub Form_Load() Child_Load Me Dim i As Integer Set rsDV = New ADODB.Recordset rsDV.Open "tblDonvi", cnn, adOpenDynamic, _ adLockOptimistic, adCmdTable '--------------------------------------------------------- With cboQuan .AddItem "Ba ®×nh", 0 .AddItem "§èng §a", 1 .AddItem "Hai Bµ Tr­ng", 2 .AddItem "Hoµn KiÕm", 3 .AddItem "Gia L©m", 4 .AddItem "Thanh Xu©n", 5 .AddItem "Tõ Liªm", 6 End With '--------------------------------------------------------- TenCT Select Case iButton 'Sua don vi hay them moi Case 2 'cmdSuaDV SuaDonVi Case 3 'cmdThem: cboCT.ListIndex = 0 cboCT.Refresh txtTenDV.Enabled = True 'txtTenDV.SetFocus txtMaDV.Enabled = True txtMaDV.Text = CodeDV(cboCT.Text) txtMaDV.Enabled = False cmdCapNhat.Enabled = False txtTenDV.Text = "" txtDiachi.Text = "" txtDT.Text = "" txtSoNV.Text = "" txtTenDV.Enabled = False txtDiachi.Enabled = False txtDT.Enabled = False txtSoNV.Enabled = False cboQuan.Enabled = False End Select Child_Unload frmDonVi End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = 0 Then cmdThoat_Click End Sub Private Sub GetValue() rsDV!MaDV = txtMaDV.Text rsDV!TenDV = txtTenDV.Text rsDV!DiaChi = txtDiachi.Text rsDV!Quan = cboQuan.Text rsDV!SoDT = txtDT.Text rsDV!DonViCT = MaDV_T(cboCT.Text) rsDV!sonv = txtSoNV.Text If optCap2.Value = True Then rsDV!Capdv = 2 Else rsDV!Capdv = 3 End If If optQLNN.Value = True Then rsDV!chucnang = "QLNN" Else rsDV!chucnang = "HCSN" End If End Sub Private Sub optCap2_Click() TenCT End Sub Private Sub optCap3_Click() TenCT End Sub Private Sub Timer1_Timer() If cboCT.Text "" Then cboQuan.Enabled = True txtTenDV.Enabled = True txtDiachi.Enabled = True txtDT.Enabled = True txtSoNV.Enabled = True End If End Sub Private Sub txtDiachi_Click() Check_Empty End Sub Private Sub txtDiaChi_GotFocus() ' CEmpty txtTenDV Hien "NhËp ®Þa chØ cña ®¬n vÞ" End Sub Private Sub txtDT_Change() Check_Empty End Sub Private Sub txtDT_GotFocus() Call CEmpty(cboQuan) Hien "§iÖn tho¹i cña ®¬n vÞ" End Sub Private Sub txtDT_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtMaDV_Click() 'Check_Empty End Sub Private Sub txtSoNV_Change() Check_Empty End Sub Private Sub txtSoNV_GotFocus() CEmpty txtDT Hien "Sè nh©n viªn hiÖn t¹i cña ®¬n vÞ" End Sub Private Sub txtSoNV_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) End Sub Private Sub txtTenDV_Click() 'Check_Empty End Sub Private Sub txtTenDV_GotFocus() Hien "NhËp tªn ®¬n vÞ vµo ®©y" End Sub Private Sub txtTenDV_KeyPress(KeyAscii As Integer) KeyAscii = Char_Check(KeyAscii) End Sub Private Sub TenCT() Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset cboCT.Clear If optCap2.Value Then cboCT.AddItem "UBND TP Hµ Néi" Else sSQL = "SELECT * FROM tbldonvi " & _ "WHERE capdv= 2;" rs.Open sSQL, cnn, adOpenDynamic, adLockOptimistic With rs .MoveFirst While .EOF = False cboCT.AddItem !TenDV .MoveNext Wend End With End If cboCT.ListIndex = 0 txtMaDV.Enabled = True txtMaDV.Text = CodeDV(cboCT.Text) txtMaDV.Enabled = False End Sub Function CDublicate(TenDV As String) As Boolean Dim sSQL As String Dim Check As Boolean sSQL = "SELECT * FROM tbldonvi WHERE tendv= '" & TenDV & "';" Dim rsDV1 As ADODB.Recordset Set rsDV1 = New ADODB.Recordset rsDV1.Open sSQL, cnn, adOpenDynamic, adLockOptimistic If rsDV1.EOF And rsDV1.BOF Then Check = False Else Check = True End If CDublicate = Check End Function Private Sub ThemDVCD(TenCT As String) Dim rsDV2 As ADODB.Recordset Set rsDV2 = New ADODB.Recordset rsDV2.Open "tbldonvi", cnn, adOpenDynamic, adLockOptimistic With rsDV2 .MoveFirst While .EOF = False And !TenDV TenCT .MoveNext Wend !sodvcd = !sodvcd + 1 .Update End With End Sub Public Function MaDV_T(Ten As String) As String 'Tim Ma don vi tu ten don vi Dim Ma As String Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset rs.Open "Tbldonvi", cnn, adOpenDynamic, adLockOptimistic With rs .MoveFirst While Not .EOF If !TenDV = Ten Then Ma = !MaDV End If .MoveNext Wend End With MaDV_T = Ma End Function Private Sub SuaDonVi() Dim i As Integer Dim l As Integer With rsDV .MoveFirst While Not .EOF And !MaDV MaDV .MoveNext Wend If !Capdv = 2 Then optCap2.Value = True ElseIf !Capdv = 3 Then optCap3.Value = True End If i = 0 While i < cboCT.ListCount cboCT.ListIndex = i If MaDV_T(cboCT.Text) = !DonViCT Then l = i i = i + 1 Wend cboCT.ListIndex = l txtMaDV.Enabled = True txtMaDV.Text = !MaDV txtMaDV.Enabled = False txtTenDV.Text = !TenDV txtDT.Text = !SoDT txtDiachi.Text = !DiaChi txtSoNV.Text = !sonv i = 0 While i < cboQuan.ListCount cboQuan.ListIndex = i If MaDV_T(cboQuan.Text) = !DonViCT Then l = i i = i + 1 Wend cboQuan.ListIndex = l If !chucnang = "qlnn" Then optQLNN.Value = True Else optHCSN.Value = True End If End With End Sub Private Sub DoiTS(MaCu As String, MaMoi As String) Dim rsDat As ADODB.Recordset Dim rsKLD As ADODB.Recordset Set rsDat = New ADODB.Recordset Set rsKLD = New ADODB.Recordset rsDat.Open "tbltonghopdat_master", cnn, adOpenDynamic, adLockOptimistic rsKLD.Open "tblTongHopTSCD_KLD_Master", cnn, adOpenDynamic, adLockOptimistic With rsDat If .EOF And .BOF Then .MoveFirst While Not .EOF And MaCu !MaDV .MoveNext Wend !MaDV = MaMoi End If End With With rsKLD If .EOF And .BOF Then .MoveFirst While Not .EOF And MaCu !MaDV .MoveNext Wend !MaDV = MaMoi End If End With End Sub Private Sub Check_Empty() Dim ctl As Control Dim B As Boolean B = True For Each ctl In Controls If TypeOf ctl Is TextBox Or TypeOf ctl Is MaskEdBox _ Or TypeOf ctl Is ComboBox Then If ctl.Text = "" Then B = False End If Next ctl If B = True Then cmdCapNhat.Enabled = True Else cmdCapNhat.Enabled = False End If End Sub 1.7 Form: frmTimKiem Dim rsDV As ADODB.Recordset Dim rsTS As ADODB.Recordset Dim i As Integer Dim Flag As Boolean Dim ok As Boolean Private Sub cboCap_KeyPress(KeyAscii As Integer) KeyAscii = Num_Check(KeyAscii) If Not (KeyAscii = "2" Or KeyAscii = "3") Then cboCap.Text = "" End If End Sub Private Sub cmdThoat_Click() Child_Unload Me End Sub Private Sub cmdTim_Click() Flag = True Select Case SSTab1.Tab Case 0 'Tim don vi TimDV iButton = 0 Case 1 'Tim tai san TimTS iButton = 1 Case 2 'Tim phieu If txtTu.Text "" Or txtDen.Text "" Then If Not IsDate(txtTu.Text) And Not IsDate(txtDen.Text) Then MsgBox "NhËp sai ®iÒu kiÖn t×m kiÕm!", , "Th«ng b¸o:" Flag = False Exit Sub End If End If TimPhieu iButton = 2 End Select If Flag Then MsgBox "Ch­a nhËp ®iÒu kiÖn t×m kiÕm", , "Th«ng b¸o:" Else Call cFind(findSQL) End If End Sub Private Sub Form_Load() Child_Load Me Set rsDV = New ADODB.Recordset rsDV.Open "tbldonvi", cnn, adOpenDynamic, adLockOptimistic i = 0 With rsDV .MoveFirst While .EOF = False cboMaDV.AddItem rsDV!MaDV, i cboTenDV.AddItem rsDV!TenDV, i i = i + 1 .MoveNext Wend End With cboCap.AddItem 1, 0 cboCap.AddItem 2, 1 cboCap.AddItem 3, 2 cboCN.AddItem "QLNN", 0 cboCN.AddItem "HCSN", 1 End Sub Private Sub TimDV() findSQL = "SELECT * FROM tbldonvi WHERE " If cboMaDV.Text "" Then findSQL = findSQL & "( madv LIKE '%" & cboMaDV.Text & "%')" Flag = False End If If cboTenDV.Text "" Then If Not Flag Then findSQL = findSQL & " AND ( tendv LIKE '%" & cboTenDV.Text & "%')" Else findSQL = findSQL & "( tendv LIKE '%" & cboTenDV.Text & "%')" End If Flag = False End If If cboCap.Text "" Then If Not Flag Then findSQL = findSQL & " AND ( capdv LIKE '%" & cboCap.Text & "%')" Else findSQL = findSQL & "( capdv LIKE '%" & cboCap.Text & "%')" End If Flag = False End If If cboCN.Text "" Then If Not Flag Then findSQL = findSQL & " AND ( Chucnang LIKE '%" & cboCN.Text & "%')" Else findSQL = findSQL & "( tendv LIKE '%" & cboTenDV.Text & "%')" End If Flag = False End If End Sub Private Sub TimTS() findSQL = "SELECT * FROM tblloaits_master" & _ " INNER JOIN tblnhom" & _ " ON tblloaits_master.maloaits=tblnhom.maloaits" & _ " WHERE " If cboMaNhomTS.Text "" Then findSQL = findSQL & " (tblnhom.manhom LIKE '%" & cboMaNhomTS.Text & "%')" Flag = False End If If cboNhom.Text "" Then If Flag Then findSQL = findSQL & " (tblnhom.tennhom LIKE '%" & cboNhom.Text & "%')" Else findSQL = findSQL & " AND (tblnhom.tennhom LIKE '%" & cboNhom.Text & "%')" End If Flag = False End If If cboLoaiTS.Text "" Then If Flag Then findSQL = findSQL & " (tblloaits_master.tenloaits LIKE '%" & cboLoaiTS.Text & "%')" Else findSQL = findSQL & " AND (tblloaits_master.tenloaits LIKE '%" & cboLoaiTS.Text & "%')" End If Flag = False End If End Sub Private Sub TimPhieu() findSQL = "SELECT * " & _ "FROM tblphieu " & _ "WHERE " If cboMP.Text "" Then findSQL = findSQL & "(tblphieu.maphieu LIKE '%" & cboMP.Text & "%')" Flag = False End If If cboNguoiLP.Text "" Then If Flag Then findSQL = findSQL & "(tblphieu.tennlp LIKE '%" & cboNguoiLP.Text & "%')" Else findSQL = findSQL & " AND (tblphieu.tennlp LIKE '%" & cboNguoiLP.Text & "%')" End If Flag = False End If If txtTu.Text "" Then If Flag Then If txtDen.Text "" Then findSQL = findSQL & " (tblphieu.ngaylp >=DateValue(Format('" & txtTu.Text & "'))) and " _ & " (tblphieu.ngaylp <=DateValue(Format('" & txtDen.Text & "'))) " Else findSQL = findSQL & " (tblphieu.ngaylp >=DateValue(Format('" & txtTu.Text & "')));" End If Else If txtDen.Text "" Then findSQL = findSQL & " AND ( tblphieu.ngaylp >=DateValue(Format('" & txtTu.Text & "'))) and " _ & " (tblphieu.ngaylp <=DateValue(Format('" & txtDen.Text & "'))) " Else findSQL = findSQL & " AND (tblphieu.ngaylp >=DateValue(Format('" & txtTu.Text & "')));" End If End If Flag = False Else If Flag Then If txtDen.Text "" Then findSQL = findSQL & " (tblphieu.ngaylp <=DateValue(Format('" & txtDen.Text & "'))) " End If Else If txtDen.Text "" Then findSQL = findSQL & " AND (tblphieu.ngaylp <=DateValue(Format('" & txtDen.Text & "'))) " End If End If Flag = False End If 'MsgBox findSQL End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = 0 Then Child_Unload Me End Sub Private Sub cFind(sql As String) Dim hang As String Dim cot As String Set rsKQ = New ADODB.Recordset rsKQ.Open findSQL, cnn, adOpenDynamic, adLockOptimistic Dim i As Integer With rsKQ If .EOF And .BOF Then If SSTab1.Tab = 0 Then MsgBox "Kh«ng t×m thÊy ®¬n vÞ ", , "Th«ng b¸o:" ElseIf SSTab1.Tab = 1 Then MsgBox "Kh«ng t×m thÊy tµi s¶n ", , "Th«ng b¸o:" Else MsgBox "Kh«ng t×m thÊy phiÕu", , "Th«ng b¸o:" End If Exit Sub rsKQ.Close Set rsKQ = Nothing Else frmTimKiemKQ.Show End If End With End Sub Private Sub SSTab1_DblClick() End Sub 1.8 Form: frmTimKiemKQ Private Sub cmdThoat_Click() Child_Unload Me End Sub Private Sub Form_Load() Dim Li As ListItem Child_Load Me With rsKQ Select Case iButton Case 0: 'Tim don vi i = 0 List.ColumnHeaders.Clear List.ColumnHeaders.Add , , "STT", 1000 List.ColumnHeaders.Add , , "M· ®¬n vÞ", 3000 List.ColumnHeaders.Add , , "Tªn ®¬n vÞ", 3000 .MoveFirst While Not .EOF Set Li = List.ListItems.Add i = i + 1 Li.Text = i Li.ListSubItems.Add Text:=!MaDV Li.ListSubItems.Add Text:=!TenDV .MoveNext Wend Case 1: 'Tim tai san List.ColumnHeaders.Clear List.ColumnHeaders.Add , , "STT", 1000 List.ColumnHeaders.Add , , "M· nhãm tµi s¶n", 3000 List.ColumnHeaders.Add , , "Tªn tµi s¶n", 3000 .MoveFirst While Not .EOF Set Li = List.ListItems.Add i = i + 1 Li.Text = i Li.ListSubItems.Add Text:=!MaNhom Li.ListSubItems.Add Text:=!tennhom .MoveNext Wend Case 2: 'Tim phieu List.ColumnHeaders.Clear List.ColumnHeaders.Add , , "STT", 1000 List.ColumnHeaders.Add , , "M· PhiÕu", 2000 List.ColumnHeaders.Add , , "Ngµy lËp phiÕu", 2000 List.ColumnHeaders.Add , , "Ng­êi lËp phiÕu", 3000 .MoveFirst While Not .EOF Set Li = List.ListItems.Add i = i + 1 Li.Text = i Li.ListSubItems.Add Text:=!Maphieu Li.ListSubItems.Add Text:=!NgayLP Li.ListSubItems.Add Text:=!TenNLP .MoveNext Wend End Select End With End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = 0 Then Child_Unload Me End Sub Private Sub Form_Unload(Cancel As Integer) rsKQ.Close Set rsKQ = Nothing End Sub Private Sub List_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then Select Case iButton Case 0: frmPopUpMenu.SetDV List.SelectedItem.ListSubItems(2).Text, List.SelectedItem.ListSubItems(1).Text Me.PopupMenu frmPopUpMenu.mnuDonvi End Select End If End Sub 1.9 Form: frmDoThi Option Explicit Private Sub Command1_Click() Chart1.Plot.Axis(VtChAxisIdY).AxisTitle.TextLayout.VertAlignment = VtVerticalAlignmentTop Chart1.Plot.Axis(VtChAxisIdY).AxisTitle = "(VND)" Chart1.Plot.Axis(VtChAxisIdY).AxisTitle.VtFont.Size = 18 With Chart1 If lisLoaiDT.ListIndex = 0 Then .chartType = VtChChartType2dBar ElseIf lisLoaiDT.ListIndex = 1 Then .chartType = VtChChartType2dPie ElseIf lisLoaiDT.ListIndex = 2 Then .chartType = VtChChartType3dBar .Plot.View3d.Elevation = 15 .Plot.View3d.Rotation = 30 End If .Refresh End With End Sub Private Sub Form_Load() Child_Load Me With Chart1 .ChartData = gt .Title = "Gi¸ trÞ Tµi s¶n" .FootnoteText = "Tµi s¶n cè ®Þnh" .Title.VtFont.Name = ".vntime" .Title.VtFont.Size = 16 .Legend.VtFont.Name = 14 .Legend.VtFont.Name = ".vntime" .Footnote.VtFont.Name = ".vntime" .Column = 1 .ColumnLabel = "Gia tri thuc te" .Column = 2 .ColumnLabel = "Gia tri ke toan" .Refresh End With '-------------------------------------------------------- lisLoaiDT.AddItem "Cét, 2D", 0 lisLoaiDT.AddItem "H×nh Trßn,2D", 1 lisLoaiDT.AddItem "Cét, 3D", 2 End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If UnloadMode = 0 Then Child_Unload Me End Sub Private Sub lisLoaiDT_dblClick() Command1_Click End Sub 2 Các Modul 2.1 Modul:cCodeNTS Option Explicit Public Const Them = 0 Public Const Sua = 1 Public MaNhom As String Function CodeNTS(MaLoai As String) Dim soN As Integer Dim Ma As String Dim MaTaiSan As String Dim rsLTS As ADODB.Recordset Set rsLTS = New ADODB.Recordset rsLTS.Open "tblLoaiTS_master", cnn, adOpenDynamic, adLockOptimistic With rsLTS .MoveFirst While Not (.EOF) If !TenloaiTS = MaLoai Then Ma = !MaloaiTS soN = !sonhom End If .MoveNext Wend End With If soN < 9 Then MaTaiSan = Right(Ma, 1) & "00" & Trim(str(soN + 1)) ElseIf soN < 99 Then MaTaiSan = Right(Ma, 1) & "0" & Trim(str(soN + 1)) Else MaTaiSan = Right(Ma, 1) & Trim(str(soN + 1)) End If CodeNTS = MaTaiSan End Function 2.2 Modul: Init Option Explicit Public Sub Set_Panel() Dim today As Date frmMDI.StatusBar.Panels.Clear Set mypanel = frmMDI.StatusBar.Panels.Add(1) mypanel.AutoSize = sbrContents 'mypanel.Width = 3000 Set mypanel = frmMDI.StatusBar.Panels.Add(2) mypanel.AutoSize = sbrSpring Set mypanel = frmMDI.StatusBar.Panels.Add(3) mypanel.AutoSize = sbrNoAutoSize mypanel.Width = 1 Set mypanel = frmMDI.StatusBar.Panels.Add(4, , , sbrIns) mypanel.AutoSize = sbrContents mypanel.Bevel = sbrInset mypanel.Alignment = sbrLeft mypanel.Width = 5 Set mypanel = frmMDI.StatusBar.Panels.Add(5, , , sbrCaps) mypanel.AutoSize = sbrContents mypanel.Bevel = sbrInset mypanel.Alignment = sbrLeft mypanel.Width = 5 Set mypanel = frmMDI.StatusBar.Panels.Add(6, , , sbrTime) today = Now() mypanel.AutoSize = sbrContents mypanel.Bevel = sbrInset mypanel.Alignment = sbrLeft mypanel.Width = 50 Set mypanel = frmMDI.StatusBar.Panels.Add(7, , , sbrDate) mypanel.AutoSize = sbrContents mypanel.Bevel = sbrInset mypanel.Width = 80 mypanel.Alignment = sbrRight End Sub Public Sub Set_Code() CodeTS = Array("00000", "10000", "20000", "30000", "40000", "50000", "60000", "70000") CodeP = "00000" Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset rs.Open "tblLoaiTS_Detail", cnn, adOpenDynamic, adLockOptimistic If rs.EOF And rs.BOF Then Exit Sub rs.MoveLast While Not rs.BOF Select Case rs!MaloaiTS Case "001": If Val(CodeTS(1)) < Val(rs!MaTS) Then CodeTS(1) = rs!MaTS Case "002": If Val(CodeTS(2)) < Val(rs!MaTS) Then CodeTS(2) = rs!MaTS Case "003": If Val(CodeTS(3)) < Val(rs!MaTS) Then CodeTS(3) = rs!MaTS Case "004": If Val(CodeTS(4)) < Val(rs!MaTS) Then CodeTS(4) = rs!MaTS Case "005": If Val(CodeTS(5)) < Val(rs!MaTS) Then CodeTS(5) = rs!MaTS Case "006": If Val(CodeTS(6)) < Val(rs!MaTS) Then CodeTS(6) = rs!MaTS Case "007": If Val(CodeTS(7)) < Val(rs!MaTS) Then CodeTS(7) = rs!MaTS End Select rs.MovePrevious Wend rs.Close Set rs = Nothing Set rs = New ADODB.Recordset rs.Open "tblPhieu", cnn, adOpenDynamic, adLockOptimistic If rs.EOF And rs.BOF Then Exit Sub rs.MoveFirst While Not rs.EOF If Val(CodeP) < Val(rs!Maphieu) Then CodeP = rs!Maphieu rs.MoveNext Wend End Sub Public Sub Set_Font() Default.Name = ".vnArial" Default.Size = 12 Default.Bold = 0 Default.Italic = 0 End Sub Public Sub Set_Menu() Dim mnu As Control Dim i As Integer On Error GoTo errh For Each mnu In frmMDI.Controls If TypeOf mnu Is Menu Then mnu.Visible = True Next With frmMDI Select Case Skin Case 0: .mnuskin1.Checked = True Case 1: .mnuSkin2.Checked = True Case 2: .mnuSkin3.Checked = True End Select End With With frmMDI Select Case GroupCode Case 0: Hien " H·y ®¨ng nhËp ®Ó khai th¸c c¸c chøc n¨ng cña ch­¬ng tr×nh " For Each mnu In frmMDI.Controls If TypeOf mnu Is Menu Then mnu.Visible = False Next .mnuHeThong.Visible = True .mnuLogOn.Visible = True .mnuThoat.Visible = True .mnuTroGiup.Visible = True .mnuHuongDan.Visible = True .mnuAbout.Visible = True .mnuSep0.Visible = True '.mnuPhuLuc.Visible = True .Toolbar.Visible = False Case 1: .Toolbar.Visible = True Case 2: .mnuAdmin.Visible = False .Toolbar.Visible = True Case 3: .mnuAdmin.Visible = False .mnuSoLieu.Visible = False .mnuHaomon.Visible = False .Toolbar.Visible = True End Select If .mnuSep10.UBound = 0 Then .mnuSep10(0).Visible = False For i = 0 To .mnuWin.UBound .mnuWin(i).Visible = False Next Else For i = 0 To .mnuWin.UBound .mnuWin(i).Visible = True Next End If End With errh: Resume Next End Sub Public Sub Set_Skin(Frm As Form) Dim ctl As Control 'Skin = 1 Select Case Skin Case 0: For Each ctl In Frm.Controls Set_Child_font Frm, ctl If TypeOf ctl Is CommandButton Then ctl.Visible = True If TypeOf ctl Is Mybutton Then ctl.Visible = False If TypeOf ctl Is Label Then ctl.ForeColor = vbBlack ctl.BackColor = bkColor_Standard End If If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox _ Or TypeOf ctl Is SSTab _ Then ctl.BackColor = vbWhite '&HF7FEE3 ctl.ForeColor = vbBlack End If If TypeOf ctl Is Frame Or TypeOf ctl Is OptionButton Then ctl.BackColor = bkColor_Standard ctl.ForeColor = &H0 End If Next Frm.BackColor = bkColor_Standard Case 1: For Each ctl In Frm.Controls Set_Child_font Frm, ctl If TypeOf ctl Is CommandButton Then ctl.Visible = False If TypeOf ctl Is Label Then ctl.BackColor = bkColor_Default ctl.ForeColor = vbWhite End If If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox _ Or TypeOf ctl Is SSTab _ Then ctl.BackColor = vbBlack '&HF7FEE3 ctl.ForeColor = vbWhite End If If TypeOf ctl Is Mybutton Then ctl.Visible = True ctl.SkinPath = App.Path & Skin_Default_Path ctl.LoadSkin ctl.ForeColor = &HFFFFFF ctl.Refresh End If If TypeOf ctl Is Frame Or TypeOf ctl Is OptionButton Then ctl.BackColor = bkColor_Default ctl.ForeColor = &HFFFFFF End If Next Frm.BackColor = bkColor_Default Case 2: For Each ctl In Frm.Controls Set_Child_font Frm, ctl If TypeOf ctl Is CommandButton Then ctl.Visible = False If TypeOf ctl Is Label Then ctl.ForeColor = vbBlack ctl.BackColor = bkColor_White End If If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox _ Or TypeOf ctl Is SSTab _ Then ctl.BackColor = vbWhite '&HF7FEE3 ctl.ForeColor = vbBlack End If If TypeOf ctl Is Mybutton Then ctl.Visible = True ctl.SkinPath = App.Path & Skin_White_Path ctl.LoadSkin ctl.ForeColor = &H0& ctl.Refresh End If If TypeOf ctl Is Frame Or TypeOf ctl Is OptionButton Then ctl.BackColor = bkColor_White ctl.ForeColor = &H0 End If Next Frm.BackColor = bkColor_White End Select End Sub Public Sub Init_icon() With frmIcon .exit.Picture = LoadResPicture(8, vbResBitmap) End With End Sub Public Sub Set_Icon() Dim hMenu As Long, hSubMenu As Long 'get the handle of the menu hMenu = GetMenu(frmMDI.hwnd) hSubMenu = GetSubMenu(hMenu, 0) SetMenuItemBitmaps hSubMenu, 8, MF_BYPOSITION, frmIcon.exit.Picture, frmIcon.exit.Picture End Sub Kết luận Sau hơn 4 năm học tập tại trường và quá trình nghiên cứu hơn 6 tháng tại Ban kiểm kê TP.Hà Nội, cũng như tự tìm hiểu công tác kiểm kê, quản lý tài sản cố định qua tài liệu sách vở, tôi nhận thấy việc học tập, nghiên cứu lý thuyết đi đôi với thực hành là công việc cực kỳ quan trọng để giúp cho việc củng cố kiến thức. Từ đó, mỗi sinh viên có thể hiểu biết sâu sắc thêm về kiến thức chuyên môn Tin Học cũng như các kiến thức về nghiệp vụ. Công tác quản lý, thống kê tài sản cố định là một nghiệp vụ rất phức tạp. Nó đòi hỏi rất nhiều nghiệp vụ đa dạng: kiến thức về kỹ thuật để định giá, xác định chất lượng còn lại của tài sản, kiến thức về kinh tế, quản lý cho việc thống kê, tính hao mòn…. Một lần nữa, tôi xin bày tỏ lòng biết ơn với các thầy, cô giáo, các cán bộ đang công tác tại trường Đại học Quản lý và Kinh Doanh, đặc biệt là thầy giáo, tiến sĩ: Hoàng Xuân Thảo, đã tận tình, chỉ bảo, giúp đỡ tôi trong suốt quá trình thực hiện đồ án này.