Đồ án Quản lý thu mua chè

Chương trình Quản lý thu mua chè được sử dụng trong các doanh nghiệp kinh doanh Chè, nên bảo mật dữ liệu là một công việc vô cùng quan trọng. Сhức năng quản lý quyền truy cập của những người được phép sử dụng chương trình cho phép doanh nghiệp có thể hạn chế việc thất thoát thông tin. Ta có thể chia nhưng người được phép sử dụng chương trình thành 2 nhóm chính: người quản trị (Aministrator), Người quản lý việc thu mua chè.  Người quản lý việc thu mua chè: là nhóm người có quyền truy cập vào Username , khi nhóm người này truy cập vào thì họ có toàn quyền sử dụng những tiện ích có trong quyền hạn của một người quản ly’‎ như : nhập hóa đơn trong việc thu mua Chè , thanh toán các hóa đơn, cập nhật giá , in hóa đơn hay thay đổi mật khẩu truy cập của mình . Tuy nhiên nhóm này vẫn nằm trong sự quản ly’ của những người có thẩm quyền cao hơn và đây chính là những Người Quản trị .  Người quản trị: Đây là nhóm người có quyền cao nhất. Ngoài các quyền hạn của nhóm người quản lý thu mua Chè, nhóm này còn được phép quản lý nhóm người kia (Như : có thể xóa bỏ người sử dụng “UserName” hay sửa chữa dữ liệu hoặc tạo mới ra các Username mới ) . In ra các báo cáo tùy vào lựa chọn của Admnistrator hay khách hàng , cập nhật tiền trong quỹ .

doc86 trang | Chia sẻ: oanh_nt | Ngày: 22/04/2015 | Lượt xem: 325 | Lượt tải: 0download
Bạn đang xem nội dung tài liệu Đồ án Quản lý thu mua chè, để tải tài liệu về máy bạn click vào nút DOWNLOAD ở trên
n With RsTongTien .MoveFirst tien = .Fields(0) .MoveFirst .Fields(0) = CDbl(tien) - CDbl(lblTongtien.Caption) .update End With End If .update End With If lblA.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Loại A", lblA.Caption) End If If lblB.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Loại B", lblB.Caption) End If If lblC.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Loại C", lblC.Caption) End If If lblD.Caption "0" Then Call SaveND(RsNoiDungMua, lblMaHD.Caption, "Loại D", lblD.Caption) End If With rsKhachHang .AddNew .Fields(0) = maKH .Fields(1) = txtTenKH.Text .Fields(2) = txtDiachi.Text .update End With End Sub Private Sub newHang() ' Khoi tao lai cac Control khi chon nhap them hang On Error Resume Next EditHD = False txtBaoBi.Text = "0" txtKhoiLuongTruoc.Text = "0" txtTylenuoc.Text = "0" chkBaobi.Value = False chkTyleNuoc.Value = False Check1.Value = 0 Check1_Click txtKhoiLuongTruoc.SetFocus End Sub Private Sub DefControls() EditHD = False lblNote.Caption = "" lblMaHD.Caption = AutoKey sFrame.Width = 3435 frmLoai2.Visible = False End Sub Private Sub EnableCont() On Error Resume Next txtKhoiLuongTruoc.Enabled = True Check1.Enabled = True chkTyleNuoc.Enabled = True chkBaobi.Enabled = True cmbLoai1.Enabled = True End Sub Private Sub ReOrder() On Error Resume Next Dim i As Integer Call ReSum If lv.ListItems.Count <= 0 Then Exit Sub End If For i = 1 To lv.ListItems.Count lv.ListItems(i).Text = i Next i End Sub Private Sub ReSum() On Error Resume Next lblA.Caption = "0" lblB.Caption = "0" lblC.Caption = "0" lblD.Caption = "0" lblTongBB.Caption = "0" lblTongKL.Caption = "0" lblTongtien.Caption = "0" If lv.ListItems.Count <= 0 Then Exit Sub End If Dim i As Integer Dim A As Double Dim B As Double Dim C As Double Dim D As Double Dim Per As Double A = 0 B = 0 C = 0 D = 0 For i = 1 To lv.ListItems.Count With lv.ListItems(i) Per = CDbl(.SubItems(3)) / 100 If .SubItems(2) = cmbLoai1.list(0) Then A = A + (Per * .SubItems(8)) End If If .SubItems(2) = cmbLoai1.list(1) Then B = B + Per * .SubItems(8) End If If .SubItems(2) = cmbLoai1.list(2) Then C = C + Per * .SubItems(8) End If If .SubItems(2) = cmbLoai1.list(3) Then D = D + Per * .SubItems(8) End If If Per < 100 Then ' Che bi lan Per = CDbl(.SubItems(5)) / 100 If .SubItems(4) = cmbLoai1.list(0) Then A = A + (Per * .SubItems(8)) End If If .SubItems(4) = cmbLoai1.list(1) Then B = B + Per * .SubItems(8) End If If .SubItems(4) = cmbLoai1.list(2) Then C = C + Per * .SubItems(8) End If If .SubItems(4) = cmbLoai1.list(3) Then D = D + Per * .SubItems(8) End If End If lblTongBB.Caption = CDbl(lblTongBB.Caption) + CDbl(lv.ListItems(i).SubItems(6)) lblTongKL.Caption = CDbl(lblTongKL.Caption) + CDbl(lv.ListItems(i).SubItems(8)) lblTongtien.Caption = CDbl(lblTongtien.Caption) + CDbl(lv.ListItems(i).SubItems(9)) End With Next i lblA.Caption = A lblB.Caption = B lblC.Caption = C lblD.Caption = D End Sub Private Sub SaveND(rsND As ADODB.Recordset, Ma As String, Loai As String, Kl As String) Dim P As Double If Loai = "Loại A" Then P = GiaA End If If Loai = "Loại B" Then P = GiaB End If If Loai = "Loại C" Then P = GiaC End If If Loai = "Loại D" Then P = GiaD End If With rsND .AddNew .Fields(0) = Ma ' Ma hoa don .Fields(1) = Loai ' Loai che .Fields(2) = P ' Gia che .Fields(7) = Kl ' Khoi luong .Fields(8) = CDbl(P) * CDbl(Kl) .update End With End Sub Private Sub update(mahd As String) Dim gia, klt, klt1, tt As Double Dim i As Integer Dim Sql As String Dim cmd As ADODB.Command If lv.ListItems.Count = 0 Then Exit Sub End If 'Call GetOldData Set cmd = New ADODB.Command For i = 1 To lv.ListItems.Count If lv.ListItems(i).SubItems(4) = "" Then If lv.ListItems(i).SubItems(2) = "Loại A" Then gia = GiaA ElseIf lv.ListItems(i).SubItems(2) = "Loại B" Then gia = GiaB ElseIf lv.ListItems(i).SubItems(2) = "Loại C" Then gia = GiaC ElseIf lv.ListItems(i).SubItems(2) = "Loại D" Then gia = GiaD End If Sql = "insert into tbl_noidungmua(mahd,loaiche,giache,khoiluongbd,phantramche,tylenuoc,baobi,khoiluongsau,giatri) values('" & mahd & "','" & lv.ListItems(i).SubItems(2) & "','" & CStr(gia) & "','" & lv.ListItems(i).SubItems(1) & "','" & lv.ListItems(i).SubItems(3) & "','" & lv.ListItems(i).SubItems(6) & "','" & lv.ListItems(i).SubItems(7) & "','" & "','" & lv.ListItems(i).SubItems(8) & "','" & lv.ListItems(i).SubItems(9) & "')" MsgBox Sql With cmd .ActiveConnection = Cnn .CommandText = Sql .Execute End With End If If lv.ListItems(i).SubItems(4) "" Then If lv.ListItems(i).SubItems(2) = "Loại A" Then gia = GiaA ElseIf lv.ListItems(i).SubItems(2) = "Loại B" Then gia = GiaB ElseIf lv.ListItems(i).SubItems(2) = "Loại C" Then gia = GiaC ElseIf lv.ListItems(i).SubItems(2) = "Loại D" Then gia = GiaD End If klt = (CDbl(lv.ListItems(i).SubItems(1)) * CDbl(lv.ListItems(i).SubItems(3))) / 100 tt = klt * gia Sql = "insert into tbl_noidungmua values('" & mahd & "','" & lv.ListItems(i).SubItems(2) & "','" & CStr(gia) & "','" & lv.ListItems(i).SubItems(1) & "','" & lv.ListItems(i).SubItems(3) & "','" & lv.ListItems(i).SubItems(6) & "','" & lv.ListItems(i).SubItems(7) & "','" & CStr(klt) & "','" & CStr(tt) & "')" With cmd .ActiveConnection = Cnn .CommandText = Sql .Execute End With If lv.ListItems(i).SubItems(4) = "Loại A" Then gia = GiaA ElseIf lv.ListItems(i).SubItems(4) = "Loại B" Then gia = GiaB ElseIf lv.ListItems(i).SubItems(4) = "Loại C" Then gia = GiaC ElseIf lv.ListItems(i).SubItems(4) = "Loại D" Then gia = GiaD End If klt1 = CDbl(lv.ListItems(i).SubItems(1)) - klt tt = klt1 * gia Sql = "insert into tbl_noidungmua values('" & mahd & "','" & lv.ListItems(i).SubItems(4) & "','" & CStr(gia) & "','" & lv.ListItems(i).SubItems(1) & "','" & lv.ListItems(i).SubItems(5) & "','" & "0" & "','" & "0" & "','" & CStr(klt1) & "','" & CStr(tt) & "')" With cmd .ActiveConnection = Cnn .CommandText = Sql .Execute End With End If Next i Set cmd = Nothing End Sub frmPrice: Dim ValA As Boolean Dim ValB As Boolean Dim ValC As Boolean Dim ValD As Boolean Private Sub CloseButton_Click() Unload Me End Sub Private Sub cmdClose_Click() '------- Refresh lai gia With frmNhap.cmbLoai1 If .Text = .list(0) Then .Text = .list(1) ElseIf .Text = .list(1) Then .Text = .list(2) ElseIf .Text = .list(2) Then .Text = .list(3) ElseIf .Text = .list(3) Then .Text = .list(1) End If End With With frmNhap.cmbLoai2 If .Text = .list(0) Then .Text = .list(1) ElseIf .Text = .list(1) Then .Text = .list(2) ElseIf .Text = .list(2) Then .Text = .list(3) ElseIf .Text = .list(3) Then .Text = .list(1) End If End With '------------------------------------- Unload Me End Sub Private Sub cmdSave_Click() If txtNewA.Text = "" Or _ txtNewB.Text = "" Or _ txtNewC.Text = "" Or _ txtNewD.Text = "" Then MsgboxC "Không thể lưu giá các loại chè !" Exit Sub End If SavePrice ValA, lblA, txtNewA SavePrice ValB, Me.lblB, Me.txtNewB SavePrice ValC, Me.lblC, Me.txtNewC SavePrice ValD, Me.lblD, Me.txtNewD txtNewA.Enabled = False txtNewB.Enabled = False txtNewC.Enabled = False txtNewD.Enabled = False End Sub Private Sub Form_Load() Call GetOldPrice imgList.ListImages.Add , , LoadResPicture("save1", 1) imgList.ListImages.Add , , LoadResPicture("no", 1) imgList.ListImages.Add , , LoadResPicture("close", 1) Set cmdSave.Picture = imgList.Overlay(1, 1) Set cmdCancel.Picture = imgList.Overlay(2, 2) Set cmdClose.Picture = imgList.Overlay(3, 3) Call InitTitleBar(Me) End Sub Private Sub imgA_Click() If ValA = False Then ValA = True imgA.Picture = imgChecked.Picture imgA.Refresh txtNewA.Enabled = True txtNewA.SetFocus Else ValA = False imgA.Picture = imgUnCheck.Picture imgA.Refresh txtNewA_LostFocus cmdCancel.SetFocus txtNewA.Enabled = False txtNewA.Text = GiaA End If SaveButton End Sub Private Sub imgA_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgA.Picture = imgTemp.Picture End Sub Private Sub lblA_Click() imgA_Click End Sub Private Sub imgb_Click() If ValB = False Then ValB = True imgB.Picture = imgChecked.Picture imgB.Refresh txtNewB.Enabled = True txtNewB.SetFocus Else ValB = False imgB.Picture = imgUnCheck.Picture imgB.Refresh txtNewB_LostFocus cmdCancel.SetFocus txtNewB.Enabled = False txtNewB.Text = GiaB End If SaveButton End Sub Private Sub imgb_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgB.Picture = imgTemp.Picture End Sub Private Sub lblb_Click() imgb_Click End Sub Private Sub lblb_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgb_MouseDown Button, Shift, X, Y End Sub Private Sub imgC_Click() If ValC = False Then ValC = True imgC.Picture = imgChecked.Picture imgC.Refresh txtNewC.Enabled = True txtNewC.SetFocus Else ValC = False imgC.Picture = imgUnCheck.Picture imgC.Refresh txtNewC_LostFocus cmdCancel.SetFocus txtNewC.Text = GiaC txtNewC.Enabled = False End If SaveButton End Sub Private Sub imgC_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgC.Picture = imgTemp.Picture End Sub Private Sub lblc_Click() imgC_Click End Sub Private Sub lblc_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgC_MouseDown Button, Shift, X, Y End Sub Private Sub imgD_Click() If ValD = False Then ValD = True imgD.Picture = imgChecked.Picture imgD.Refresh txtNewD.Enabled = True txtNewD.SetFocus Else ValD = False imgD.Picture = imgUnCheck.Picture imgD.Refresh txtNewD_LostFocus cmdCancel.SetFocus txtNewD.Text = GiaD txtNewD.Enabled = False End If SaveButton End Sub Private Sub imgD_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgD.Picture = imgTemp.Picture End Sub Private Sub lblD_Click() imgD_Click End Sub Private Sub lblD_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) imgD_MouseDown Button, Shift, X, Y End Sub Private Sub txtNewA_Change() With txtNewA If .Text = "" Then Exit Sub End If .Text = Format(.Text, "#,###") .SelStart = Len(.Text) If Len(.Text) > 7 Then MsgboxC "Giá 1kg chè không được lớn hơn 6 số" .Text = "0" Exit Sub End If End With End Sub Private Sub txtNewD_KeyPress(KeyAscii As MSForms.ReturnInteger) txtNewA_KeyPress KeyAscii End Sub Private Sub txtNewD_LostFocus() With txtNewD .BackColor = C3 .SelStart = 0 .SelLength = 0 End With End Sub Private Sub SavePrice(Save As Boolean, Lbl As VB.Label, Tx As MSForms.TextBox) If Save = False Then Exit Sub End If With RsGiaChe .AddNew .Fields(1) = Lbl.Caption .Fields(2) = Tx.Text .Fields(3) = Date If UserName = "" Then .Fields(4) = "Error !" Else .Fields(4) = UserName End If .update End With With RsOldData If .RecordCount <= 0 Then .AddNew End If .MoveFirst .Fields(0) = "Loại A" .Fields(1) = CDbl(txtNewA.Text) GiaA = CDbl(txtNewA.Text) .MoveNext .Fields(0) = "Loại B" .Fields(1) = CDbl(txtNewB.Text) GiaB = CDbl(txtNewB.Text) .MoveNext .Fields(0) = "Loại C" .Fields(1) = CDbl(txtNewC.Text) GiaC = CDbl(txtNewC.Text) .MoveNext .Fields(0) = "Loại D" .Fields(1) = CDbl(txtNewD.Text) GiaD = CDbl(txtNewD.Text) .update End With End Sub Public Sub SaveButton() If ValA = False And ValB = False And ValC = False And ValD = False Then cmdSave.Enabled = False Else cmdSave.Enabled = True End If End Sub Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub Private Sub pTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub frmThanhToanNo: Const CB_SHOWDROPDOWN = &H14F Dim Tmp Private Sub CloseButton_Click() Unload Me End Sub Private Sub cmdThanhToan_Click() Dim max As Integer If (Text3.Text = "") Or (Text5.Text = "") Then Exit Sub End If If RsHoaDon.RecordCount <= 0 Then Exit Sub End If RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(0) = Text1.Text Then If CDbl(Text3.Text) >= CDbl(Text5.Text) Then RsHoaDon.Fields(6).Value = CDbl(Text3.Text) - CDbl(Text5.Text) If RsNo.RecordCount <= 0 Then RsNo.AddNew RsNo.Fields(0).Value = Text1.Text RsNo.Fields(1).Value = Date RsNo.Fields(2).Value = CDbl(Text5.Text) RsNo.Fields(3).Value = max + 1 RsNo.update Else RsNo.MoveFirst Do Until RsNo.EOF = True If RsNo.Fields(0).Value = Text1.Text Then max = 1 If max < RsNo.Fields(3).Value Then max = RsNo.Fields(3).Value End If RsNo.MoveNext Loop RsNo.AddNew RsNo.Fields(0).Value = Text1.Text RsNo.Fields(1).Value = Date RsNo.Fields(2).Value = CDbl(Text5.Text) RsNo.Fields(3).Value = max + 1 RsNo.update End If ElseIf CDbl(Text3.Text) < CDbl(Text5.Text) Then frmMsgOk.lblTitle = "Chú ý" frmMsgOk.lblPrompt = " Số thanh toán không được lớn hơn số nợ" frmMsgOk.Show Text5.Text = "" End If End If RsHoaDon.MoveNext Loop Call Create_List Call Clear_Text End Sub Private Sub lblTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub Private Sub list_DblClick() Dim Stt As Integer If Text1.Text "" Then SendStr = Text1.Text frmXemNo.Show Else Exit Sub End If End Sub Private Sub list_ItemClick(ByVal Item As MSComctlLib.ListItem) Dim Stt As Integer Text5.Enabled = True For Stt = 1 To list.ListItems.Count If list.ListItems(Stt).Selected = True Then Text1.Text = list.ListItems(Stt).SubItems(1) Text2.Text = list.ListItems(Stt).SubItems(2) Text3.Text = list.ListItems(Stt).SubItems(3) End If Next If RsHoaDon.RecordCount <= 0 Then Exit Sub End If RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(0) = Text1.Text Then If rsKhachHang.RecordCount <= 0 Then Exit Sub End If rsKhachHang.MoveFirst Do Until rsKhachHang.EOF = True If rsKhachHang.Fields(0) = RsHoaDon.Fields(1) Then Text6.Text = rsKhachHang.Fields(2) End If rsKhachHang.MoveNext Loop End If RsHoaDon.MoveNext Loop End Sub Private Sub MyButton1_Click() Unload Me End Sub Private Sub pTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngReturnValue As Long If Button = 1 Then Call ReleaseCapture lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&) End If End Sub Private Sub Form_Load() Call InitTitleBar(Me) Call Create_List Call CreateRs Text4.Text = "Hôm nay, ngày " & DatePart("d", Date) & " tháng " & DatePart("m", Date) & " năm " & DatePart("yyyy", Date) Text5.Enabled = False End Sub Public Sub Create_List() Dim Stt As Integer list.ColumnHeaders.Clear list.ColumnHeaders.Add 1, , "Số TT", 400 list.ColumnHeaders.Add 2, , "Mã Hoá đơn", 1600 list.ColumnHeaders.Add 3, , "Tên người bán", 1500 list.ColumnHeaders.Add 4, , "Số tiền nợ", 1000, 1 list.FullRowSelect = True list.ListItems.Clear If RsHoaDon.RecordCount <= 0 Then Exit Sub End If RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(6) > 0 Then If rsKhachHang.RecordCount <= 0 Then Exit Sub End If rsKhachHang.MoveFirst Do Until rsKhachHang.EOF = True If (RsHoaDon.Fields(1) = rsKhachHang.Fields(0)) Then Stt = Stt + 1 list.ListItems.Add , , Stt list.ListItems(Stt).SubItems(1) = RsHoaDon.Fields(0) list.ListItems(Stt).SubItems(2) = rsKhachHang.Fields(1) list.ListItems(Stt).SubItems(3) = Format(RsHoaDon.Fields(6), "#,###") End If rsKhachHang.MoveNext Loop End If RsHoaDon.MoveNext Loop '------------ Text5.Enabled = False End Sub Private Sub Text5_KeyPress(KeyAscii As Integer) If KeyAscii = 8 Then Exit Sub End If If KeyAscii = 13 Then Call cmdThanhToan_Click End If If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0 End If End Sub frmMainAdmin Dim C As Boolean Public Sub InitForm() bottom1.BackColor = ColorMain SetParent frmMenu.hWnd, frameMenu.hWnd frmMenu.Show MoveWindow frmMenu.hWnd, 0, -30, frmMenu.Width, frmMenu.Height, 1 ani1.LoadFile App.Path & "\animation\daihung1.gif", False End Sub Private Sub cmdLog_Click() If RsUserLog.RecordCount <= 0 Then Else RsUserLog.MoveLast RsUserLog.Fields(2) = Now RsUserLog.update End If '-------------------- Unload prj_BuyTea.frmNhap Set frmNhap = Nothing Unload prj_BuyTea.frmThanhToanNo Set frmThanhToanNo = Nothing Unload prj_BuyTea.frmPrice Set frmPrice = Nothing Unload prj_BuyTea.frmMainUser Set frmMainUser = Nothing Unload prj_BuyTea.frmChangePass Set frmChangePass = Nothing Unload prj_BuyTea.Rpt_HoaDon Set Rpt_HoaDon = Nothing Unload prj_BuyTea.frmBaocao Set frmBaocao = Nothing Unload prj_BuyTea.frm_DoThi Set frm_DoThi = Nothing Unload prj_BuyTea.frmDataMan Set frmDataMan = Nothing Unload prj_BuyTea.frmMoney Set frmMoney = Nothing Unload prj_BuyTea.frmUserMan Set frmUserMan = Nothing Unload prj_BuyTea.frmMenu Set Menu = Nothing Unload prj_BuyTea.Form1 Set Form1 = Nothing Unload prj_BuyTea.frmXemNo Set frmXemNo = Nothing '--------------- Unload Me Set frmMainAdmin = Nothing frmLogin.Show End Sub Private Sub Form_Load() Call InitForm End Sub Private Sub cmdThoat_Click() Dim ans ans = MsgboxC("Bạn có muốn thoát khỏi chương trình không ?", vbYesNo, "Thoát khỏi chương trình !") If ans = vbYes Then If RsUserLog.RecordCount <= 0 Then Else RsUserLog.MoveLast RsUserLog.Fields(2) = Now RsUserLog.update End If End End If End Sub Private Sub tmTime_Timer() Dim H As String Dim M As String H = Hour(Now) If Minute(Now) < 10 Then M = "0" & Minute(Now) Else M = Minute(Now) End If If C = False Then lblTime.Caption = H & ":" & M C = True Else lblTime.Caption = H & " " & M C = False End If End Sub frmUserMan: Dim uName As String ' User Name Dim uEdit As Boolean Private Sub DefaultCtl() lblNote.Caption = "" imgListUser.ListImages.Add , "user0", LoadResPicture("user0", 1) imgListUser.ListImages.Add , "user1", LoadResPicture("user1", 1) imgListUser.ListImages.Add , "user2", LoadResPicture("user2", 1) End Sub Private Sub CloseButton_Click() Unload Me End Sub Private Sub cmdAbort_Click() Call ButtonEnabled(True) Call LockText End Sub Private Sub cmdDel_Click() If uName = "administrator" Then MsgboxC "Thông tin về nhà quản lý không thể bị xoá . Xin vui lòng chọn một người khác !", vbCritical Exit Sub End If Dim ans As Byte ans = MsgboxC("Bạn có muốn xoá tên truy nhập : '" & uName & "' không ?", vbYesNo) If ans = vbYes Then If RsUser.RecordCount <= 0 Then Exit Sub End If RsUser.MoveFirst Do While Not RsUser.EOF If RsUser.Fields(0) = uName Then RsUser.Delete RsUser.update txtUserName.Text = "" txtPass.Text = "" txtConf.Text = "" chkNo.Value = False chkGia.Value = False Exit Do End If RsUser.MoveNext Loop Call CreateLV End If End Sub Private Sub cmdEdit_Click() If uName = "administrator" Then MsgboxC "Thông tin về nhà quản lý không thể bị thay đổi. Để đổi mật khẩu xin chọn mục Đổi mật khẩu !", vbCritical Exit Sub End If If uName = "" Then MsgboxC "Bạn phải chọn một người dùng trong danh sách trên !", vbInformation Exit Sub End If cmdEdit.Visible = False Call ButtonEnabled(False) lvUser2.Enabled = False txtUserName.Enabled = True txtPass.Enabled = True txtConf.Enabled = True chkNo.Enabled = True chkGia.Enabled = True Call EditUser(uName) uEdit = True End Sub Private Sub cmdMain_Click() Unload Me End Sub Private Sub cmdNew_Click() uEdit = False Call ButtonEnabled(False) txtUserName.Text = "" txtUserName.Enabled = True txtPass.Text = "" txtPass.Enabled = True txtConf.Text = "" txtConf.Enabled = True chkGia.Enabled = True chkGia.Value = False chkNo.Enabled = True chkNo.Value = False End Sub Private Sub cmdSave_Click() If txtUserName.Text = "" Then MsgboxC "Bạn phải nhận tên người sử dụng !" txtUserName.SetFocus Exit Sub End If If Len(txtUserName.Text) > 15 Or Len(txtUserName.Text) < 6 Then MsgboxC "Tên truy nhập phải dài hơn 6 ký tự và ngắn hơn 15 ký tự !" txtUserName.SetFocus Exit Sub End If If txtPass.Text = "" Then MsgboxC "Mật khẩu chưa được nhập !" txtConf.SetFocus Exit Sub End If If Len(txtPass.Text) > 12 Then MsgboxC "Mật khẩu phải ngắn hơn 12 ký tự !" txtConf.SetFocus Exit Sub End If If txtConf.Text txtPass.Text Then MsgboxC "Mật khẩu xác nhận bị sai . Xin vui lòng nhập lại !" txtConf.SetFocus Exit Sub End If If uEdit = True Then RsUser.Fields(0) = txtUserName.Text RsUser.Fields(1) = txtPass.Text If chkGia.Value = True Then RsUser.Fields(2) = "1" Else RsUser.Fields(2) = "0" End If If chkNo.Value = True Then RsUser.Fields(3) = "1" Else RsUser.Fields(3) = "0" End If RsUser.update Else RsUser.AddNew RsUser.Fields(0) = txtUserName.Text RsUser.Fields(1) = txtPass.Text If chkGia.Value = True Then RsUser.Fields(2) = "1" Else RsUser.Fields(2) = "0" End If If chkNo.Value = True Then RsUser.Fields(3) = "1" Else RsUser.Fields(3) = "0" End If RsUser.update End If Call ButtonEnabled(True) Call LockText Call CreateLV End Sub Private Sub Form_Load() Skin1.LoadSkin App.Path & "\s1.skn" Skin1.ApplySkin lvUser2.hWnd Call CreateCnn Call CreateRs Call DefaultCtl Call CreateLV Call InitTitleBar(Me) s1.Height = Me.Height End Sub Private Sub CreateLV() lvUser2.ListItems.Clear If RsUser.RecordCount <= 0 Then Exit Sub End If Dim U As Integer RsUser.MoveFirst Do While Not RsUser.EOF U = U + 1 lvUser2.ListItems.Add , , RsUser.Fields(0), "user1" If CInt(RsUser.Fields(2)) = 1 Or CInt(RsUser.Fields(3)) = 1 Then lvUser2.ListItems(U).Icon = "user2" End If If RsUser.Fields(0) = "administrator" Then lvUser2.ListItems(U).Icon = "user0" End If RsUser.MoveNext Loop End Sub Private Sub ButtonEnabled(Be As Boolean) cmdNew.Visible = False cmdDel.Visible = False cmdEdit.Visible = False cmdMain.Visible = False cmdSave.Visible = False cmdAbort.Visible = False DoEvents cmdNew.Enabled = Be cmdDel.Enabled = Be cmdEdit.Enabled = Be cmdMain.Enabled = Be cmdSave.Enabled = Not Be cmdAbort.Enabled = Not Be lvUser2.Enabled = Be cmdNew.Visible = True cmdDel.Visible = True cmdEdit.Visible = True cmdMain.Visible = True cmdSave.Visible = True cmdAbort.Visible = True DoEvents End Sub Private Sub VisibleEdit() Me.Height = 6885 Me.Top = 0 Me.Left = 0 frmUserInf.Visible = True frmButton.Top = frmUserInf.Top + frmUserInf.Height + 100 frmNote.Top = frmButton.Top + frmButton.Height End Sub Private Sub EditUser(n As String) On Error GoTo e1 Dim i As Integer RsUser.MoveFirst Do While Not RsUser.EOF i = i + 1 If RsUser.Fields(0) = n Then txtUserName.Text = RsUser.Fields(0) txtPass.Text = RsUser.Fields(1) txtConf.Text = txtPass.Text chkGia.Value = CInt(RsUser.Fields(2)) chkNo.Value = CInt(RsUser.Fields(3)) uPos = i Exit Sub End If RsUser.MoveNext Loop e1: End Sub Private Sub lvUser2_ItemClick(ByVal Item As MSComctlLib.ListItem) Call Display(Item.Text) uName = Item.Text End Sub Private Function CheckName() As Boolean On Error GoTo e1 RsUser.MoveFirst Do While Not RsUser.EOF If LCase(txtUserName.Text) = LCase(RsUser.Fields(0)) Then CheckName = True Exit Function End If RsUser.MoveNext Loop e1: End Function frmBaoCao: Private Sub imgBaoCao_Click() 'Tab Bao cao Thu Mua ---------- imgBaocao.Visible = False imgBaocao1.Visible = True DT_Lich = Date frm_ThuMua.Visible = True OptDate.Value = True optMuaChe.Value = True Call Add_cmbLoai(cmbChonLoaiPL) cmbChonLoaiPL.Text = "Toàn bộ" Call Create_ListThuMua 'Tab User access ------------------ imgUser1.Visible = False imgUser.Visible = True frm_ListUser.Visible = False End Sub Private Sub imgUser_Click() 'Tab Bao cao Thu mua -------- imgBaocao.Visible = True imgBaocao1.Visible = False frm_ThuMua.Visible = False 'Tab User Access ----------------- imgUser1.Visible = True imgUser.Visible = False frm_ListUser.Visible = True DT_Lich_User = Date OptDate_User.Value = True OptTimeAccess_User.Value = True cmbViewUser_User.Enabled = False End Sub '--------------------------------------------Tabstrip USER----------------------------------------------- Private Sub Create_ListUser() Dim Stt As Integer ListUser.ListItems.Clear Call ListviewHeader_UserAccess(ListUser) If RsUserLog.RecordCount = 0 Then Exit Sub End If Stt = 0 If OptDate_User.Value = True Then RsUserLog.MoveFirst Do Until RsUserLog.EOF = True If DatePart("d", RsUserLog.Fields(1)) = DT_Lich_User.Day _ And DatePart("m", RsUserLog.Fields(1)) = DT_Lich_User.Month _ And DatePart("yyyy", RsUserLog.Fields(1)) = DT_Lich_User.Year Then Call ListviewDetail_UserAccess(ListUser, RsUserLog, Stt) End If RsUserLog.MoveNext Loop ElseIf OptMonth_User.Value = True Then RsUserLog.MoveFirst Do Until RsUserLog.EOF = True If DatePart("m", RsUserLog.Fields(1)) = DT_Lich_User.Month _ And DatePart("yyyy", RsUserLog.Fields(1)) = DT_Lich_User.Year Then Call ListviewDetail_UserAccess(ListUser, RsUserLog, Stt) End If RsUserLog.MoveNext Loop ElseIf OptYear_User.Value = True Then RsUserLog.MoveFirst Do Until RsUserLog.EOF = True If DatePart("yyyy", RsUserLog.Fields(1)) = DT_Lich_User.Year Then Call ListviewDetail_UserAccess(ListUser, RsUserLog, Stt) End If RsUserLog.MoveNext Loop End If End Sub Private Sub Create_ListviewUser_Update() Dim No As Integer Dim Stt As Integer ListUser.ListItems.Clear Call ListviewHeader_UserUpdate(ListUser) If RsGiaChe.RecordCount <= 0 Then Exit Sub End If If OptDate_User.Value = True Then RsGiaChe.MoveFirst Do Until RsGiaChe.EOF = True If RsGiaChe.Fields(3) = DT_Lich_User Then Call ListviewDetail_UserUpdate(ListUser, RsGiaChe, Stt, cmbViewUser_User) End If RsGiaChe.MoveNext Loop ElseIf OptMonth_User.Value = True Then RsGiaChe.MoveFirst Do Until RsGiaChe.EOF = True If DatePart("yyyy", RsGiaChe.Fields(3)) = DT_Lich_User.Year _ And DatePart("m", RsGiaChe.Fields(3)) = DT_Lich_User.Month Then Call ListviewDetail_UserUpdate(ListUser, RsGiaChe, Stt, cmbViewUser_User) End If RsGiaChe.MoveNext Loop ElseIf OptYear_User.Value = True Then RsGiaChe.MoveFirst Do Until RsGiaChe.EOF = True If DatePart("yyyy", RsGiaChe.Fields(3)) = DT_Lich_User.Year Then Call ListviewDetail_UserUpdate(ListUser, RsGiaChe, Stt, cmbViewUser_User) End If RsGiaChe.MoveNext Loop End If End Sub Private Sub Create_ListviewUser_Contact() Dim Stt As Integer ListUser.ListItems.Clear Call ListviewHeader_UserAccess_Contact(ListUser) If RsHoaDon.RecordCount <= 0 Then Exit Sub End If If OptDate_User.Value = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(3) = DT_Lich_User Then Call ListviewDetail_UserAccess_Contact(ListUser, RsHoaDon, rsKhachHang, Stt, cmbViewUser_User) End If RsHoaDon.MoveNext Loop ElseIf OptMonth_User.Value = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich_User.Year _ And DatePart("m", RsHoaDon.Fields(3)) = DT_Lich_User.Month Then Call ListviewDetail_UserAccess_Contact(ListUser, RsHoaDon, rsKhachHang, Stt, cmbViewUser_User) End If RsHoaDon.MoveNext Loop ElseIf OptYear_User.Value = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich_User.Year Then Call ListviewDetail_UserAccess_Contact(ListUser, RsHoaDon, rsKhachHang, Stt, cmbViewUser_User) End If RsHoaDon.MoveNext Loop End If End Sub Private Sub cmbViewUser_User_Click() If OptTimeAccess_User = True Then Call Create_ListUser ElseIf OptListOperation_User = True Then Call Create_ListviewUser_Update ElseIf Me.OptHD_User = True Then Call Create_ListviewUser_Contact End If End Sub Private Sub DT_Lich_User_Change() If OptTimeAccess_User.Value = True Then cmbViewUser_User.Enabled = False Call Create_ListUser ElseIf OptListOperation_User.Value = True Then ElseIf OptHD_User.Value = True Then Call Create_ListviewUser_Contact End If End Sub Private Sub OptMonth_User_Click() If OptTimeAccess_User.Value = True Then cmbViewUser_User.Enabled = False Call Create_ListUser ElseIf OptHD_User.Value = True Then Call Create_ListviewUser_Contact ElseIf OptListOperation_User = True Then Call Create_ListviewUser_Update End If End Sub Private Sub OptYear_User_Click() If OptTimeAccess_User.Value = True Then cmbViewUser_User.Enabled = False Call Create_ListUser ElseIf OptHD_User.Value = True Then Call Create_ListviewUser_Contact ElseIf OptListOperation_User = True Then Call Create_ListviewUser_Update End If End Sub Private Sub OptDate_User_Click() If OptTimeAccess_User.Value = True Then cmbViewUser_User.Enabled = False Call Create_ListUser ElseIf OptHD_User.Value = True Then Call Create_ListviewUser_Contact ElseIf OptListOperation_User = True Then Call Create_ListviewUser_Update End If End Sub Private Sub OptHD_User_Click() cmbViewUser_User.Enabled = True Call AddCombo(RsUser, 0, cmbViewUser_User) Call Create_ListviewUser_Contact cmbViewUser_User.Text = "Toàn bộ" End Sub Private Sub OptListOperation_User_Click() Call Create_ListviewUser_Update cmbViewUser_User.Enabled = True Call AddCombo(RsUser, 0, cmbViewUser_User) cmbViewUser_User.Text = "Toàn bộ" End Sub Private Sub OptTimeAccess_User_Click() Call Create_ListUser cmbViewUser_User.Enabled = False End Sub '--------------------------------------------Tabstrip Thu Mua----------------------------------------------- Private Sub Create_ListThuMua() Dim Stt As Integer ListThuMua.ListItems.Clear Call ListviewHeader_ThuMua(ListThuMua) If RsHoaDon.RecordCount = 0 Then Exit Sub End If Stt = 0 '--------------------------------------------------------------------- If Me.OptDate = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True 'If IsNull(RsHoaDon.Fields(6)) = True Or RsHoaDon.Fields(6) = "0" Then If RsHoaDon!ngaymua = DT_Lich Then Call ListviewDetail_ThuMua(ListThuMua, RsHoaDon, Stt) End If 'End If RsHoaDon.MoveNext Loop ElseIf Me.OptMonth = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True 'If IsNull(RsHoaDon.Fields(6)) = True Or RsHoaDon.Fields(6) = "0" Then If (DatePart("m", RsHoaDon!ngaymua) = DT_Lich.Month) _ And (DatePart("yyyy", RsHoaDon!ngaymua) = DT_Lich.Year) Then Call ListviewDetail_ThuMua(ListThuMua, RsHoaDon, Stt) End If 'End If RsHoaDon.MoveNext Loop ElseIf Me.OptYear = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True 'If IsNull(RsHoaDon.Fields(6)) = True Or RsHoaDon.Fields(6) = "0" Then If DatePart("yyyy", RsHoaDon!ngaymua) = DT_Lich.Year Then Call ListviewDetail_ThuMua(ListThuMua, RsHoaDon, Stt) End If 'End If RsHoaDon.MoveNext Loop End If Dim i As Integer Dim TongKL As Double Dim TongGT As Double TongKL = 0 TongGT = 0 If ListThuMua.ListItems.Count 0 Then For j = 1 To ListThuMua.ListItems.Count TongKL = TongKL + CDbl(ListThuMua.ListItems(j).ListSubItems(5).Text) TongGT = TongGT + CDbl(ListThuMua.ListItems(j).ListSubItems(6).Text) Next End If lblKhoiLuong.Caption = Format(CDbl(TongKL), "#,###") lblGiaTri.Caption = Format(CDbl(TongGT), "#,###") Label12.Caption = "Giá trung bình : " If lblGiaTri.Caption = "" Or lblKhoiLuong.Caption = "" Then lblGt_tb.Caption = 0 Else lblGt_tb.Caption = Format(CDbl(lblGiaTri.Caption) / CDbl(lblKhoiLuong.Caption), "#,###") End If End Sub Private Sub Create_ListPhanLoai() Dim No As Integer Dim Stt As Integer ListThuMua.ListItems.Clear Call ListviewHeader_PhanLoai(ListThuMua) If RsHoaDon.RecordCount = 0 Then Exit Sub End If Stt = 0 '--------------------------------------------------------------------- If Me.OptDate = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(3) = DT_Lich Then Call ListviewDetail_PhanLoai(ListThuMua, RsHoaDon, RsNoiDungMua, Stt, cmbChonLoaiPL, No) End If RsHoaDon.MoveNext Loop ElseIf Me.OptMonth = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If (DatePart("m", RsHoaDon.Fields(3)) = DT_Lich.Month) _ And (DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich.Year) Then Call ListviewDetail_PhanLoai(ListThuMua, RsHoaDon, RsNoiDungMua, Stt, cmbChonLoaiPL, No) End If RsHoaDon.MoveNext Loop ElseIf Me.OptYear = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich.Year Then Call ListviewDetail_PhanLoai(ListThuMua, RsHoaDon, RsNoiDungMua, Stt, cmbChonLoaiPL, No) End If RsHoaDon.MoveNext Loop End If Dim i As Integer Dim TongKL As Double Dim TongGT As Double TongKL = 0 TongGT = 0 If ListThuMua.ListItems.Count 0 Then For j = 1 To ListThuMua.ListItems.Count TongKL = TongKL + CDbl(ListThuMua.ListItems(j).ListSubItems(6).Text) TongGT = TongGT + CDbl(ListThuMua.ListItems(j).ListSubItems(7).Text) Next End If lblKhoiLuong.Caption = Format(CDbl(TongKL), "#,###") lblGiaTri.Caption = Format(CDbl(TongGT), "#,###") Label12.Caption = "Giá trung bình : " If lblGiaTri.Caption = "" Or lblKhoiLuong.Caption = "" Then lblGt_tb.Caption = 0 Else lblGt_tb.Caption = Format(CDbl(lblGiaTri.Caption) / CDbl(lblKhoiLuong.Caption), "#,###") End If End Sub Private Sub Create_ListNo() Dim Stt As Integer ListThuMua.ListItems.Clear Call ListviewHeader_No(ListThuMua) If RsHoaDon.RecordCount = 0 Then Exit Sub End If Stt = 0 '--------------------------------------------------------------------- If Me.OptDate = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If RsHoaDon.Fields(3) = DT_Lich Then Call ListviewDetail_No(ListThuMua, RsHoaDon, rsKhachHang, Stt, chkNo) End If RsHoaDon.MoveNext Loop ElseIf Me.OptMonth = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If (DatePart("m", RsHoaDon.Fields(3)) = DT_Lich.Month) _ And (DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich.Year) Then Call ListviewDetail_No(ListThuMua, RsHoaDon, rsKhachHang, Stt, chkNo) End If RsHoaDon.MoveNext Loop ElseIf Me.OptYear = True Then RsHoaDon.MoveFirst Do Until RsHoaDon.EOF = True If DatePart("yyyy", RsHoaDon.Fields(3)) = DT_Lich.Year Then Call ListviewDetail_No(ListThuMua, RsHoaDon, rsKhachHang, Stt, chkNo) End If RsHoaDon.MoveNext Loop End If Dim i As Integer Dim TongKL As Double Dim TongGT As Double TongKL = 0 TongGT = 0 If ListThuMua.ListItems.Count 0 Then For j = 1 To ListThuMua.ListItems.Count If ListThuMua.ListItems(j).ListSubItems(7).Text "" Then TongGT = TongGT + CDbl(ListThuMua.ListItems(j).ListSubItems(7).Text) Else TongGT = TongGT + 0 End If Next End If lblGiaTri.Caption = Format(CDbl(TongGT), "#,###") If lblGiaTri.Caption = "" Or lblKhoiLuong.Caption = "" Then lblGt_tb.Caption = 0 End If End Sub Private Sub Create_ListTongHop() Dim Stt As Integer ListThuMua.ListItems.Clear Call ListviewHeader_TongHop(ListThuMua) If OptMonth = True Then Call ListviewDetail_TongHop(ListThuMua, Stt, "thang", DT_Lich) ElseIf OptYear = True Then Call ListviewDetail_TongHop(ListThuMua, Stt, "nam", DT_Lich) End If Dim i As Integer Dim TongKL As Double Dim TongGT As Double Dim TongNo As Double TongKL = 0 TongGT = 0 If ListThuMua.ListItems.Count 0 Then For j = 1 To ListThuMua.ListItems.Count TongKL = TongKL + CDbl(ListThuMua.ListItems(j).ListSubItems(2).Text) TongGT = TongGT + CDbl(ListThuMua.ListItems(j).ListSubItems(3).Text) If ListThuMua.ListItems(j).ListSubItems(4).Text "" Then TongNo = TongNo + CDbl(ListThuMua.ListItems(j).ListSubItems(4).Text) Else TongNo = TongNo + 0 End If Next End If lblKhoiLuong.Caption = Format(CDbl(TongKL), "#,###") lblGiaTri.Caption = Format(CDbl(TongGT), "#,###") Call Label_No_UnHide Label12.Caption = "Tổng giá trị nợ :" lblGt_tb.Caption = Format(CDbl(TongNo), "#,###") End Sub Private Sub Label_No_Hide() Label2.Caption = "Tổng tiền nợ : " Label3.Visible = False Label1.Visible = False Label7.Visible = False Label12.Visible = False lblGt_tb.Visible = False lblKhoiLuong.Visible = False End Sub Private Sub Label_No_UnHide() Label2.Caption = "Tổng giá trị : " Label3.Visible = True Label1.Visible = True Label7.Visible = True Label12.Visible = True lblGt_tb.Visible = True lblKhoiLuong.Visible = True End Sub Private Sub OptDate_Click() If optMuaChe.Value = True Then Call Create_ListThuMua Call Label_No_UnHide ElseIf optPhanLoaiChe.Value = True Then Call Create_ListPhanLoai Call Label_No_UnHide ElseIf optNo.Value = True Then Call Create_ListNo Call Label_No_Hide End If End Sub Private Sub optYear_Click() If optMuaChe.Value = True Then Call Create_ListThuMua Call Label_No_UnHide ElseIf optPhanLoaiChe.Value = True Then Call Create_ListPhanLoai Call Label_No_UnHide ElseIf optNo.Value = True Then Call Create_ListNo Call Label_No_Hide ElseIf optTongHop.Value = True Then Call Create_ListTongHop End If End Sub Private Sub optMonth_Click() If optMuaChe.Value = True Then Call Create_ListThuMua Call Label_No_UnHide ElseIf optPhanLoaiChe.Value = True Then Call Create_ListPhanLoai Call Label_No_UnHide ElseIf optNo.Value = True Then Call Create_ListNo Call Label_No_Hide ElseIf optTongHop.Value = True Then Call Create_ListTongHop End If End Sub Private Sub DT_Lich_Change() If optMuaChe.Value = True Then Call Create_ListThuMua Call Label_No_UnHide ElseIf optPhanLoaiChe.Value = True Then Call Create_ListPhanLoai Call Label_No_UnHide ElseIf optNo.Value = True Then Call Create_ListNo ElseIf optTongHop.Value = True Then Call Create_ListTongHop End If End Sub Private Sub optTongHop_Click() Call Create_ListTongHop OptDate.Enabled = False Me.cmbChonLoaiPL.Visible = False Me.chkNo.Visible = False End Sub Private Sub optPhanLoaiChe_Click() Me.cmbChonLoaiPL.Visible = True chkNo.Visible = False lblChonLoai.Visible = True Call Create_ListPhanLoai Call Label_No_UnHide OptDate.Enabled = True End Sub Private Sub optMuaChe_Click() Call Create_ListThuMua Call Label_No_UnHide Me.cmbChonLoaiPL.Visible = False chkNo.Visible = False lblChonLoai.Visible = False OptDate.Enabled = True End Sub Private Sub optNo_Click() Call Create_ListNo Me.cmbChonLoaiPL.Visible = False chkNo.Visible = True lblChonLoai.Visible = False Call Label_No_Hide OptDate.Enabled = True End Sub Private Sub cmbChonLoaiPL_Click() Call Create_ListPhanLoai OptDate.Enabled = True End Sub Private Sub chkNo_Click() Call Create_ListNo End Sub Private Sub cmdPrint_Click() Dim Sql As String '------------------- Thu mua che ------------------------------ If optMuaChe = True Then Dim rsMuaChe As Recordset With rptMuaChe .BottomMargin = 1000 .LeftMargin = 1000 .RightMargin = 1000 .TopMargin = 1000 .ReportWidth = 9000 End With If OptDate = True Then Sql = " SELECT tbl_HoaDon.NgayMua, tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, Sum(tbl_HoaDon.Tongtien) AS TongTien, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.NgayMua, tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi " & _ "HAVING ((cstr(tbl_HoaDon.NgayMua)='" & DT_Lich & "')); " ElseIf OptYear = True Then Sql = " SELECT tbl_HoaDon.NgayMua, tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, Sum(tbl_HoaDon.Tongtien) AS TongTien, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.NgayMua, tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi " & _ " HAVING ((cstr(datepart('yyyy',tbl_HoaDon.NgayMua))='" & DT_Lich.Year & " ')); " ElseIf OptMonth = True Then Sql = " SELECT Year([NgayMua]) AS [year], Month([NgayMua]) AS [month], tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY Year([NgayMua]), Month([NgayMua]), tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi " & _ " HAVING (((Year([NgayMua]))='" & DT_Lich.Year & "' ) AND ((Month([NgayMua]))='" & DT_Lich.Month & "')); " End If Set rsMuaChe = New Recordset rsMuaChe.Open Sql, Cnn, adOpenKeyset Set rptMuaChe.DataSource = rsMuaChe rptMuaChe.Show '--------------- Danh sach hoa don no ---------------------- ElseIf optNo = True Then Dim rsNoTra As Recordset With rptNo .BottomMargin = 1000 .LeftMargin = 1000 .RightMargin = 1000 .TopMargin = 1000 .ReportWidth = 9000 End With With rptNoTra .BottomMargin = 1000 .LeftMargin = 1000 .RightMargin = 1000 .TopMargin = 1000 .ReportWidth = 9000 End With If OptDate = True Then If chkNo.Value = 0 Then Sql = " SELECT tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua " & _ " HAVING ((cstr(tbl_HoaDon.NgayMua)='" & DT_Lich & "') AND ((Sum(tbl_HoaDon.[No]))CInt(0))); " Else Sql = " SELECT tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua " & _ " HAVING ((cstr(tbl_HoaDon.NgayMua)='" & DT_Lich & "') AND ((Sum(tbl_HoaDon.[No]))=CInt(0))); " End If ElseIf OptMonth = True Then '---------------------------------- If chkNo.Value = 0 Then Sql = " SELECT Month([NgayMua]) AS [month], Year([NgayMua]) AS [year], tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiLuong, sum(tbl_HoaDon.Tongtien) AS TongTien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY Month([NgayMua]), Year([NgayMua]), tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi" & _ " HAVING ((cstr(Month([NgayMua]))='" & DT_Lich.Month & "') AND (cstr(Year([NgayMua]))='" & DT_Lich.Year & "' ) AND ((Sum(tbl_HoaDon.[No]))CInt(0))); " Else Sql = " SELECT Month([NgayMua]) AS [month], Year([NgayMua]) AS [year], tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiLuong, sum(tbl_HoaDon.Tongtien) AS TongTien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY Month([NgayMua]), Year([NgayMua]), tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi" & _ " HAVING ((cstr(Month([NgayMua]))='" & DT_Lich.Month & "') AND (cstr(Year([NgayMua]))='" & DT_Lich.Year & "' ) AND ((Sum(tbl_HoaDon.[No]))=CInt(0))); " End If '--------------------------------- ElseIf OptYear = True Then If chkNo.Value = 0 Then Sql = " SELECT tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua " & _ " HAVING ((cstr(datepart('yyyy',tbl_HoaDon.NgayMua))='" & DT_Lich.Year & "') AND ((Sum(tbl_HoaDon.[No]))CInt(0))); " Else Sql = " SELECT tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.[No]) AS [No] " & _ " FROM tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH " & _ " GROUP BY tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_HoaDon.NgayMua " & _ " HAVING ((cstr(datepart('yyyy',tbl_HoaDon.NgayMua))='" & DT_Lich.Year & "') AND ((Sum(tbl_HoaDon.[No]))=CInt(0))); " End If End If Set rsNoTra = New Recordset rsNoTra.Open Sql, Cnn, adOpenKeyset Set rptNoTra.DataSource = rsNoTra rptNoTra.Show '------------------------------ Tong hop ------------------------------ ElseIf optTongHop = True Then Dim rsTongHop As Recordset With rptTongHop .BottomMargin = 1000 .LeftMargin = 1000 .RightMargin = 1000 .TopMargin = 1000 .ReportWidth = 9000 End With If OptMonth = True Then Sql = " SELECT tbl_HoaDon.NgayMua as MuaNgay, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.[No]) AS [No] " & _ " From tbl_HoaDon " & _ " GROUP BY tbl_HoaDon.NgayMua " & _ " HAVING ((CStr(DatePart('yyyy',[NgayMua]))='" & DT_Lich.Year & "' And CStr(DatePart('m',[NgayMua]))='" & DT_Lich.Month & "')); " ElseIf OptYear = True Then Sql = " SELECT Year([NgayMua]) AS nam, 'Thỏng ' & Month([NgayMua]) & ' năm ' & Year([NgayMua]) AS MuaNgay, Sum(tbl_HoaDon.Tongtien) AS Tongtien, Sum(tbl_HoaDon.TongKhoiluong) AS TongKhoiluong, Sum(tbl_HoaDon.[No]) AS [No] " & _ " From tbl_HoaDon " & _ " GROUP BY Year([NgayMua]), Month([NgayMua]) " & _ " HAVING (((Year([NgayMua]))='" & DT_Lich.Year & "' )) " & _ "ORDER BY Year([NgayMua]), Month([NgayMua]); " End If Set rsTongHop = New Recordset rsTongHop.Open Sql, Cnn, adOpenKeyset Set rptTongHop.DataSource = rsTongHop rptTongHop.Show '-------------PHAN LOAI CHE ----------------------------- ElseIf optPhanLoaiChe = True Then Dim rsPhanLoaiChe As Recordset With rptPhanLoaiChe .BottomMargin = 800 .LeftMargin = 750 .RightMargin = 750 .TopMargin = 800 .ReportWidth = 9500 End With If OptDate = True Then Sql = " SELECT tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe, Sum(tbl_NoidungMua.KhoiluongSau) AS KhoiLuong, Sum(tbl_NoidungMua.GiaChe) AS GiaChe, Sum(tbl_NoidungMua.Giatri) AS Giatri " & _ " FROM (tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH) INNER JOIN tbl_NoidungMua ON tbl_HoaDon.MaHD = tbl_NoidungMua.MaHD " & _ " GROUP BY tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe " & _ " HAVING ((cstr(tbl_HoaDon.NgayMua)='" & DT_Lich & "' )); " ElseIf OptYear = True Then Sql = " SELECT tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe, Sum(tbl_NoidungMua.KhoiluongSau) AS KhoiLuong, Sum(tbl_NoidungMua.GiaChe) AS GiaChe, Sum(tbl_NoidungMua.Giatri) AS Giatri " & _ " FROM (tbl_HoaDon INNER JOIN tbl_KhachHang ON tbl_HoaDon.MaKH = tbl_KhachHang.MaKH) INNER JOIN tbl_NoidungMua ON tbl_HoaDon.MaHD = tbl_NoidungMua.MaHD " & _ " GROUP BY tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe " & _ " HAVING ((cstr(datepart('yyyy',tbl_HoaDon.NgayMua))='" & DT_Lich.Year & "' )); " ElseIf OptMonth = True Then Sql = " SELECT tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe, tbl_NoidungMua.KhoiluongSau AS KhoiLuong, tbl_NoidungMua.GiaChe AS GiaChe, tbl_NoidungMua.Giatri AS Giatri " & _ " FROM (tbl_KhachHang INNER JOIN tbl_HoaDon ON tbl_KhachHang.MaKH = tbl_HoaDon.MaKH) INNER JOIN tbl_NoidungMua ON tbl_HoaDon.MaHD = tbl_NoidungMua.MaHD " & _ " GROUP BY tbl_HoaDon.NgayMua, tbl_HoaDon.MaHD, tbl_KhachHang.TenKH, tbl_KhachHang.DiaChi, tbl_NoidungMua.LoaiChe, tbl_NoidungMua.KhoiluongSau, tbl_NoidungMua.GiaChe, tbl_NoidungMua.Giatri; " & _ " HAVING ((CStr(DatePart('m',[ngaymua]))='" & DT_Lich.Month & "' And CStr(DatePart('yyyy',[ngaymua]))='" & DT_Lich.Year & "' ));" End If Set rsPhanLoaiChe = New Recordset rsPhanLoaiChe.Open Sql, Cnn, adOpenKeyset Set rptPhanLoaiChe.DataSource = rsPhanLoaiChe rptPhanLoaiChe.Show End If End Sub

Các file đính kèm theo tài liệu này:

  • docP0013.doc
Tài liệu liên quan