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ỹ .
86 trang |
Chia sẻ: oanh_nt | Lượt xem: 1412 | Lượt tải: 0
Bạn đang xem trước 20 trang tài liệu Đồ án Quản lý thu mua chè, để xem tài liệu hoàn chỉnh 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:
- P0013.doc