Đề tài Phân tích hệ thống thông tin quản lý bán hàng

Những ứng dụng Visual Basic có thể đáp ứng một số lượng lớn sự kiện chuột, bàn phím. Ví dụ FORM, hộp ảnh và những điều khiển ảnh có thể phát hiện vị trí con trỏ chuột có thể quyết định phím trái hay phím phải được nhấn,và có thể đáp ứng được những tổ hợp của phím chuột với phím Shift, Ctrl hay Alt. Sử dụng những điều khiển phím, ta có thể lập trình những điều khiển và FORM để đáp ứng các hành động phím hoặc phiên dịch bộ mã Ascii của ký tự.

 

doc153 trang | Chia sẻ: maiphuongdc | Lượt xem: 1418 | Lượt tải: 0download
Bạn đang xem trước 20 trang tài liệu Đề tài Phân tích hệ thống thông tin quản lý bán hàng, để xem tài liệu hoàn chỉnh bạn click vào nút DOWNLOAD ở trên
, SQLTimkiemKH If dataKhachhangLoc.Recordset.RecordCount = 0 Then MsgBox "Không tìm thấy khách hàng có mã: " & cboKhachhangLocMa.Text & "", vbInformation, "Thông báo" cboKhachhangLocMa.SelStart = 0 cboKhachhangLocMa.SelLength = Len(cboKhachhangLocMa.Text) Exit Sub Else lblKQTK.Visible = True End If loi: End Sub Private Sub Form_Load() Dim SQL As String SQL = "Select KhachhangID From tblKhachhang" HienForm Me CauhinhLuoiPhu VSFlexGridKhachhangLoc KhoitaoADODB SQL With cboKhachhangLocMa .AddItem "Tất cả" End With With rsado Do Until .EOF = True cboKhachhangLocMa.AddItem .Fields("KhachhangID").Value .MoveNext Loop .Close End With End Sub Private Sub Form_Unload(Cancel As Integer) cnado.Close Set cnado = Nothing End Sub Option Explicit Private Sub cmdBangtinh_Click() On Error GoTo loi Shell "C:\WINDOWS\CALC.EXE", vbMaximizedFocus loi: Exit Sub End Sub Private Sub cmdBCBHTheoHH_Click() rptBCBHTheoHH.Show End Sub Private Sub cmdBCBHTheoNCC_Click() rptBCBHTheoNCC.Show End Sub Private Sub cmdBCBHTheonhom_Click() rptBCBHTheoNhomHH.Show End Sub Private Sub cmdBCBHTheoNV_Click() rptBCBHTheoNV.Show End Sub Private Sub cmdBCBHTheoQui_Click() imgMuiten.Visible = True frmQui.Show End Sub Private Sub cmdBCDSSP_Click() frmBCHang.Show imgMuiten1.Visible = True End Sub Private Sub cmdBCBHTheothang_Click() rptBCBHTheoThang.Show End Sub Private Sub cmdBCDSHH_Click() imgMuiten1.Visible = True frmBCHang.Show End Sub Private Sub cmdBCDSKhach_Click() rptDSKhachhang.Show End Sub Private Sub cmdExcel_Click() On Error GoTo loi Shell "C:\Program Files\Microsoft Office\Office\EXCEL.EXE", vbMaximizedFocus loi: Exit Sub End Sub Private Sub cmdHanghoa_Click() frmSanpham.Show End Sub Private Sub cmdLuuDL_Click() On Error GoTo loi Dim Ten As String With comdHopthoai .CancelError = True .DialogTitle = "Bạn phải đặt tên File thì mới Backup được dữ liêu" .Filter = "Text Files(*.txt)|*.txt|Microsoft Words(*.doc)|*.doc|All Files(*.*)|*.*" .FilterIndex = 1 .MaxFileSize = 200 .InitDir = "C:\QLKH\Backup" .ShowSave Screen.MousePointer = 99 Screen.MouseIcon = LoadPicture("C:\QLKH\GRAPHICS\CURSORS\Wait07.cur") Ten = frmChitietHD.VSFlexGrid1ChitietHD.Name frmChitietHD.VSFlexGrid1ChitietHD.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll Ten = frmHDBanhang.VSFlexGrid1HD.Name frmHDBanhang.VSFlexGrid1HD.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll Ten = frmKhachhang.VSFlexGridKhachhang.Name frmKhachhang.VSFlexGridKhachhang.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll Ten = frmNguoigui.VSFlexGrid1NgGui.Name frmNguoigui.VSFlexGrid1NgGui.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll Ten = frmNhaCCap.VSFlexGrid1Ncc.Name frmNhaCCap.VSFlexGrid1Ncc.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll Ten = frmNhanvienbanhang.VSFlexGrid1Nnbh.Name frmNhanvienbanhang.VSFlexGrid1Nnbh.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll Ten = frmNhomSP.VSFlexGrid1NhomHH.Name frmNhomSP.VSFlexGrid1NhomHH.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll Ten = frmSanpham.VSFlexGrid1SP.Name frmSanpham.VSFlexGrid1SP.SaveGrid .InitDir & "\" & Right$(Ten, Len(Ten) - 10) & ".txt", flexFileAll MousePointer = 0 End With loi: End Sub Private Sub cmdLuuDL_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With lblChuthich .Visible = True .Caption = "Cho phép bạn lưu bảng dữ liệu lên tệp *.txt với tên tệp được đặt tự động" End With End Sub Private Sub cmdNapDL_Click() frmXemDLCu.Show End Sub Private Sub cmdNapDL_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With lblChuthich .Visible = True .Caption = "Cho phép bạn xem dữ liệu đẫ được backup lên tệp *.txt" End With End Sub Private Sub cmdNhapCTietHD_Click() frmChitietHD.Show End Sub Private Sub cmdNhapHDBH_Click() frmHDBanhang.Show End Sub Private Sub cmdNhapKhachhang_Click() frmKhachhang.Show End Sub Private Sub cmdNhapNCC_Click() frmNhaCCap.Show End Sub Private Sub cmdNhapNguoigui_Click() frmNguoigui.Show End Sub Private Sub cmdNhapNhomSP_Click() frmNhomSP.Show End Sub Private Sub cmdThoatCT_Click() Unload Me End Sub Private Sub cmdQLNSD_Click() MsgBox "Tính năng này sẽ được phát triển trong phiên bản sau", vbInformation, "Thông báo" End Sub Private Sub cmdQLNSD_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With lblChuthich .Visible = True .Caption = "Tính năng này chưa được nghiên cứu,xin bạn hãy chờ đến phiên bản sau" End With End Sub Private Sub cmdThoat_Click() Unload Me End Sub Private Sub cmdTonghop_Click() imgMuiten2.Visible = True frmTonghop.Show End Sub Private Sub cmdTonghop_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With lblChuthichTH .Visible = True .Caption = "Cho phép ta xem thông tin dưới dạng lưới cô đọng hoặc có thể xuất dữ liệu lên Excel" End With End Sub Private Sub cmdTrogiup_Click() MsgBox "Tính năng này sẽ được phát triển trong phiên bản sau.", vbInformation, "Thông báo" End Sub Private Sub cmdTrogiup_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With lblChuthich .Visible = True .Caption = "Tính năng này chưa có" End With End Sub Private Sub cmdWord_Click() On Error GoTo loi Shell "C:\Program Files\Microsoft Office\Office\WINWORD.EXE", vbMaximizedFocus loi: Exit Sub End Sub Private Sub cmdXemTT_Click() frmTreeView.Show End Sub Private Sub cmdXemTT_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With lblChuthichTT .Visible = True .Caption = "Cung cấp thông tin một cách trực quan về kết quả bán hàng của từng nhân viên,hàng hoá v.v..." End With End Sub Private Sub cmdXoaDL_Click() If MsgBox("Thực hiện công việc này sẽ làm cho dữ liệu bị xoá hết.Bạn có muốn tiếp tục hay không?", vbYesNo + vbCritical, "Thông báo") = vbYes Then XoaTatCaDL frmChitietHD.dataCTHD XoaTatCaDL frmHDBanhang.dataHDBH XoaTatCaDL frmNhanvienbanhang.dataNvbh XoaTatCaDL frmKhachhang.dataKhachhang XoaTatCaDL frmNguoigui.dataNguoigui XoaTatCaDL frmSanpham.dataSanpham XoaTatCaDL frmNhaCCap.dataNhaCC XoaTatCaDL frmSanpham.dataSanpham Else Exit Sub End If End Sub Private Sub cmdXoaDL_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With lblChuthich .Visible = True .Caption = "Nghịch vào đây sẽ rất nguy hiển,dữ liệu sẽ bị mất tất,hãy cẩn thận nhé." End With End Sub Private Sub cmnNhapNVBH_Click() frmNhanvienbanhang.Show End Sub Private Sub Form_Load() HienForm Me Me.tabLienket.Tab = 0 lblChuchay.Top = 120 lblChuchay.Left = Picture2.Width End Sub Private Sub Form_Unload(Cancel As Integer) Unload frmQui Unload frmBCHang Unload frmTonghop Unload frmDothi Unload frmXemDLCu End Sub Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With lblChuthichTT .Visible = False End With End Sub Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With lblChuthichTH .Visible = False End With End Sub Private Sub Image3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) With lblChuthich .Visible = False End With End Sub Private Sub Timer1_Timer() Dim X As Integer X = 15 If lblChuchay.Left > -lblChuchay.Width Then lblChuchay.Left = lblChuchay.Left - X Else lblChuchay.Left = frmLienket.Picture2.Width 'Timer1_Timer End If End Sub Option Explicit Private GuiTT As String Private Sub cmdLocnhanh_Click() frmNguoiguiLoc.Show End Sub Private Sub cmdLuu_Click() 'Gọi thủ tục KhoitaolucLuu KhoitaoControlsLucLuu Me With dataNguoigui.Recordset .Fields("MaNGui").Value = txtNgGuiMa.Text .Fields("TenCtyGui").Value = txtNgGuiTenCty.Text .Fields("Dienthoai").Value = txtNgGuiDThoai.Text .Fields("Fax").Value = txtNgGuiFax.Text .Fields("Email").Value = txtNgGuiE_mail.Text .Fields("Wedside").Value = txtNgGuiSide.Text .Update End With dataNguoigui.Refresh 'Gọi thủ tục dataNguoigui.Recordset.MoveLast Vohieuhoa Me End Sub Private Sub cmdThem_Click() Dim SQLMatudong As String SQLMatudong = "Select Max([MaNGui]) as Lonnhat From tblNguoigui" 'Gọi thủ tục tạo data kết nối cho txtNguoiguiMa Ketnoi dataMatudong, SQLMatudong dataNguoigui.Recordset.AddNew 'Gọi thủ tục để khởi tạo Controls lúc thêm KhoitaoControlsLucThem Me 'Tự động điền mã vào txtNguoiguimMa If dataNguoigui.Recordset.RecordCount = 0 Then txtNgGuiMa.Text = "1" dataNguoigui.Caption = "1" Else With dataMatudong txtNgGuiMa.Text = "" & .Recordset.Fields("Lonnhat").Value + 1 dataNguoigui.Caption = "" & .Recordset.Fields("Lonnhat").Value + 1 End With End If txtNgGuiTenCty.SetFocus lblMatudong.Visible = True End Sub Private Sub cmdXoa_Click() If dataNguoigui.Recordset.RecordCount > 0 Then If dataNguoiguiCtietHD.Recordset.RecordCount > 0 Then MsgBox "Bạn không thể xoá được bản ghi này,vì nó còn xuất hiện trong bảng con.", vbInformation, "Thông báo" Exit Sub Else 'Gọi thủ tục xoá Xoa dataNguoigui dataNguoigui.Recordset.MoveLast End If Else MsgBox "Không có dữ liệu để xoá.", vbInformation, "Thông báo" Exit Sub End If End Sub Private Sub dataNguoigui_Reposition() On Error GoTo loi Dim SQLNguoiguiCTHD As String SQLNguoiguiCTHD = "Select *" & _ " From tblHoadon" & _ " Where NGuiID=" & dataNguoigui.Recordset.Fields("MaNGui").Value & "" 'Gọi thủ tục tạo data kết nối cho lưới phụ Ketnoi dataNguoiguiCtietHD, SQLNguoiguiCTHD With dataNguoigui .Caption = "" & .Recordset.Fields("MaNGui").Value End With With VSFlexGrid1NgGuiCTHD .MergeCells = flexMergeRestrictColumns .MergeCol(5) = True End With loi: End Sub Private Sub Form_Load() Dim SQLNguoigui As String SQLNguoigui = "Select * From tblNguoigui" 'Gọi thủ tục HienForm HienForm Me 'Gọi thủ tục vô hiệu hoá các điều khiển không cần thiết Vohieuhoa Me 'Gọi thủ tục khởi tạo data kết nối Ketnoi dataNguoigui, SQLNguoigui 'Gọi thủ tục định dạng lưới CauhinhLuoiChinh VSFlexGrid1NgGui CauhinhLuoiPhu VSFlexGrid1NgGuiCTHD End Sub Private Sub txtNgGuiDThoai_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNgGuiDThoai, KeyAscii If KeyAscii = 13 Then txtNgGuiFax.SetFocus End If End Sub Private Sub txtNgGuiDThoai_LostFocus() BuocphaidienDL txtNgGuiDThoai, True End Sub Private Sub txtNgGuiE_mail_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNgGuiE_mail, KeyAscii If KeyAscii = 13 Then txtNgGuiSide.SetFocus End If End Sub Private Sub txtNgGuiE_mail_LostFocus() BuocphaidienDL txtNgGuiE_mail, False End Sub Private Sub txtNgGuiFax_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNgGuiFax, KeyAscii If KeyAscii = 13 Then txtNgGuiE_mail.SetFocus End If End Sub Private Sub txtNgGuiFax_LostFocus() BuocphaidienDL txtNgGuiFax, True End Sub Private Sub txtNgGuiSide_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNgGuiSide, KeyAscii If KeyAscii = 13 Then cmdLuu.SetFocus End If End Sub Private Sub txtNgGuiSide_LostFocus() BuocphaidienDL txtNgGuiSide, False End Sub Private Sub txtNgGuiTenCty_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNgGuiTenCty, KeyAscii If KeyAscii = 13 Then txtNgGuiDThoai.SetFocus End If End Sub Private Sub txtNgGuiTenCty_LostFocus() BuocphaidienDL txtNgGuiTenCty, True End Sub Private Sub VSFlexGrid1NgGui_AfterEdit(ByVal Row As Long, ByVal Col As Long) On Error GoTo loi With VSFlexGrid1NgGui If (.Col 0) And (.Cell(flexcpText, .RowSel, .ColSel) GuiTT) Then If MsgBox("Bạn có muốn lưu ô này vào trong CSDL hay không?", vbYesNo, "Thông báo") = vbNo Then .Cell(flexcpText, .RowSel, .ColSel) = GuiTT Exit Sub Else .Cell(flexcpForeColor, .RowSel, .ColSel) = vbRed End If Else Exit Sub End If End With loi: If Col = 0 Then MsgBox "Bạn không thể thay đổi dữ liệu trên cột này.", vbInformation, "Thông báo" With VSFlexGrid1NgGui .Cell(flexcpForeColor, .RowSel, .ColSel) = vbBlack End With Exit Sub End If End Sub Private Sub VSFlexGrid1NgGui_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean) With VSFlexGrid1NgGui GuiTT = .Cell(flexcpText, .RowSel, .ColSel) End With End Sub Private Sub VSFlexGrid1NgGui_EnterCell() 'Gọi thủ tục VaoO VSFlexGrid1NgGui, Label1 End Sub Private Sub VSFlexGrid1NgGui_LeaveCell() 'Gọi thủ tục RoikhoiO VSFlexGrid1NgGui End Sub Private Sub VSFlexGrid1NgGui_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Gọi thủ tục HienToolTipText VSFlexGrid1NgGui End Sub Private Sub VSFlexGrid1NgGuiCTHD_EnterCell() VaoO VSFlexGrid1NgGuiCTHD, Label1 End Sub Private Sub VSFlexGrid1NgGuiCTHD_LeaveCell() RoikhoiO VSFlexGrid1NgGuiCTHD End Sub Private Sub VSFlexGrid1NgGuiCTHD_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) HienToolTipText VSFlexGrid1NgGuiCTHD End Sub Option Explicit Private Sub cmdTimkiem_Click() On Error GoTo loi Dim SQLTkiemNGui As String If cboLocNGuima.Text = "Tất cả" Then SQLTkiemNGui = "Select * From tblNguoigui" Else SQLTkiemNGui = "Select *" & _ " From tblNguoigui" & _ " Where MaNGui=" & cboLocNGuima.Text & "" End If Ketnoi dataNGuiLoc, SQLTkiemNGui If dataNGuiLoc.Recordset.RecordCount = 0 Then MsgBox "Không tìm thấy người gửi có mã: " & cboLocNGuima.Text & "", vbInformation, "Thông báo" cboLocNGuima.SelStart = 0 cboLocNGuima.SelLength = Len(cboLocNGuima.Text) Exit Sub Else lblKQTK.Visible = True End If loi: End Sub Private Sub Form_Load() Dim SQL As String SQL = "Select * From tblNguoigui" HienForm Me CauhinhLuoiPhu VSFlexGridNguiTK KhoitaoADODB SQL With cboLocNGuima .AddItem "Tất cả" End With With rsado Do While .EOF = False cboLocNGuima.AddItem .Fields("MaNGui").Value .MoveNext Loop .Close End With End Sub Private Sub Form_Unload(Cancel As Integer) cnado.Close Set cnado = Nothing End Sub Option Explicit Private GuiTT As String Private Sub cboNCCNuoc_KeyPress(KeyAscii As Integer) PheChuanKeyPress cboNCCNuoc, KeyAscii If KeyAscii = 13 Then meditDthoaiNcc.SetFocus End If End Sub Private Sub cboNCCNuoc_LostFocus() BuocphaidienDL cboNCCNuoc, True End Sub Private Sub cboNCCTpho_KeyPress(KeyAscii As Integer) PheChuanKeyPress cboNCCTpho, KeyAscii If KeyAscii = 13 Then cboNCCVung.SetFocus End If End Sub Private Sub cboNCCTpho_LostFocus() BuocphaidienDL cboNCCTpho, True End Sub Private Sub cboNCCVung_KeyPress(KeyAscii As Integer) PheChuanKeyPress cboNCCVung, KeyAscii If KeyAscii = 13 Then txtNCCmavung.SetFocus End If End Sub Private Sub cboNCCVung_LostFocus() BuocphaidienDL cboNCCVung, True End Sub Private Sub cmdLocnhanh_Click() frmNhaCCLoc.Show End Sub Private Sub cmdLuu_Click() 'Gọi thủ tục khởi tạo Controls lúc luu KhoitaoControlsLucLuu Me With dataNhaCC.Recordset .Fields("MaNhaCC").Value = txtNCCma.Text .Fields("TenCtyNcc").Value = txtNCCten.Text .Fields("TenDTNcc").Value = txtNCCTenDT.Text .Fields("ChucdanhDTNcc").Value = txtNCCChucdanh.Text .Fields("DiachiNcc").Value = rtxtDiachiNcc.Text .Fields("ThanhphoNcc").Value = cboNCCTpho.Text .Fields("VungNcc").Value = cboNCCVung.Text .Fields("MavungNcc").Value = txtNCCmavung.Text .Fields("NuocNcc").Value = cboNCCNuoc.Text .Fields("DienthoaiNcc").Value = meditDthoaiNcc.Text .Fields("FaxNcc").Value = txtNCCFax.Text .Fields("WedsideNcc").Value = txtNCCWed.Text .Fields("EmailNcc").Value = txtNCCEmail.Text .Update End With dataNhaCC.Refresh 'Gọi thủ tục Vohieuhoa dataNhaCC.Recordset.MoveLast Vohieuhoa Me End Sub Private Sub cmdThem_Click() Dim SQLMatudong As String SQLMatudong = "Select Max([MaNhaCC]) as Lonnhat From tblNhacungcap" 'Gọi thủ tục tạo Data kết nối để tạo nguồn kết nối cho txtNccma Ketnoi dataMatudong, SQLMatudong dataMatudong.Refresh dataNhaCC.Recordset.AddNew 'Gọi hàm để qui định thuộc tính các Controls lúc Thêm KhoitaoControlsLucThem Me If dataNhaCC.Recordset.RecordCount = 0 Then txtNCCma.Text = "1" dataNhaCC.Caption = "1" Else With dataMatudong txtNCCma.Text = "" & .Recordset.Fields("Lonnhat").Value + 1 dataNhaCC.Caption = "Nhà CC: " & .Recordset.Fields("Lonnhat").Value + 1 End With End If txtNCCten.SetFocus lblTudong.Visible = True End Sub Private Sub cmdXoa_Click() If dataNhaCC.Recordset.RecordCount > 0 Then If dataNccChitietSp.Recordset.RecordCount > 0 Then MsgBox "Bạn không thể xoá bản ghi này vì nó còn xuất hiện trong bảng con.", vbInformation, "Thông báo" Exit Sub Else 'Gọi thủ tục Xoa Xoa dataNhaCC dataNhaCC.Recordset.MoveLast End If Else MsgBox "Không có dữ liệu để xoá.", vbInformation, "Thông báo" Exit Sub End If End Sub Private Sub dataNhaCC_Reposition() On Error GoTo loi Dim SQLNccCTietSP As String SQLNccCTietSP = "Select *" & _ " From tblSanpham" & _ " Where NhaCCID=" & dataNhaCC.Recordset.Fields("MaNhaCC").Value & "" 'Gọi thủ tục khởi tạo data kết nỗi cho lưới chi tiết Ketnoi dataNccChitietSp, SQLNccCTietSP dataNccChitietSp.Refresh With dataNhaCC .Caption = "" & .Recordset.Fields("ManhaCC").Value End With With VSFlexGrid1NccCtietSP .MergeCells = flexMergeRestrictColumns .MergeCol(2) = True End With loi: End Sub Private Sub Form_Load() Dim SQLNhaCC As String SQLNhaCC = "Select * From tblNhacungcap Order By NuocNcc" 'Gọi thủ tục Vohieuhoa các Controls Vohieuhoa Me 'Gọi thủ tục hiện Form HienForm Me 'Gọi thủ tục tạo data kết nối với nguồn dữ liệu Ketnoi dataNhaCC, SQLNhaCC optTron(1).Value = True 'Cấu hình thuộc tính cho lưới CauhinhLuoiChinh VSFlexGrid1Ncc CauhinhLuoiPhu VSFlexGrid1NccCtietSP With cboNCCTpho .AddItem "Hà Nội" .AddItem "Hải Phòng" .AddItem "Tp HCM" .AddItem "Đà Nẵng" .AddItem "Nam Định" End With With cboNCCVung .AddItem "Bắc" .AddItem "Trung" .AddItem "Nam" .AddItem "Hải đảo" .AddItem "Miền Núi" End With With cboNCCNuoc .AddItem "Việt Nam" .AddItem "Trung Quốc" .AddItem "Thái Lan" .AddItem "Indonesia" .AddItem "Malaysia" End With End Sub Private Sub meditDthoaiNcc_KeyPress(KeyAscii As Integer) PheChuanKeyPress meditDthoaiNcc, KeyAscii If KeyAscii = 13 Then txtNCCFax.SetFocus End If End Sub Private Sub meditDthoaiNcc_LostFocus() BuocphaidienDL meditDthoaiNcc, True End Sub Private Sub optTron_Click(Index As Integer) Select Case Index Case 1 optTron(0).Value = False With VSFlexGrid1Ncc .MergeCells = flexMergeNever End With Case 0 optTron(1).Value = False With VSFlexGrid1Ncc .MergeCells = flexMergeRestrictColumns .MergeCol(8) = True End With Case Else End Select End Sub Private Sub rtxtDiachiNcc_KeyPress(KeyAscii As Integer) PheChuanKeyPress rtxtDiachiNcc, KeyAscii If KeyAscii = 13 Then cboNCCTpho.SetFocus End If End Sub Private Sub rtxtDiachiNcc_LostFocus() BuocphaidienDL rtxtDiachiNcc, True End Sub Private Sub txtNCCChucdanh_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNCCChucdanh, KeyAscii If KeyAscii = 13 Then rtxtDiachiNcc.SetFocus End If End Sub Private Sub txtNCCDThoai_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNCCDThoai, KeyAscii If KeyAscii = 13 Then txtNCCFax.SetFocus End If End Sub Private Sub txtNCCChucdanh_LostFocus() BuocphaidienDL txtNCCChucdanh, True End Sub Private Sub txtNCCEmail_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNCCEmail, KeyAscii If KeyAscii = 13 Then txtNCCWed.SetFocus End If End Sub Private Sub txtNCCEmail_LostFocus() BuocphaidienDL txtNCCEmail, False End Sub Private Sub txtNCCFax_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNCCFax, KeyAscii If KeyAscii = 13 Then txtNCCEmail.SetFocus End If End Sub Private Sub txtNCCFax_LostFocus() BuocphaidienDL txtNCCFax, True End Sub Private Sub txtNCCma_KeyPress(KeyAscii As Integer) 'Gọi thủ tục PheChuan PheChuanKeyPress txtNCCma, KeyAscii If KeyAscii = 13 Then txtNCCten.SetFocus End If End Sub Private Sub txtNCCmavung_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNCCmavung, KeyAscii If KeyAscii = 13 Then cboNCCNuoc.SetFocus End If End Sub Private Sub txtNCCmavung_LostFocus() BuocphaidienDL txtNCCmavung, True End Sub Private Sub txtNCCten_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNCCten, KeyAscii If KeyAscii = 13 Then txtNCCTenDT.SetFocus End If End Sub Private Sub txtNCCten_LostFocus() BuocphaidienDL txtNCCten, True End Sub Private Sub txtNCCTenDT_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNCCTenDT, KeyAscii If KeyAscii = 13 Then txtNCCChucdanh.SetFocus End If End Sub Private Sub txtNCCTenDT_LostFocus() BuocphaidienDL txtNCCTenDT, True End Sub Private Sub txtNCCWed_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtNCCWed, KeyAscii If KeyAscii = 13 Then cmdLuu.SetFocus End If End Sub Private Sub txtNCCWed_LostFocus() BuocphaidienDL txtNCCWed, False End Sub Private Sub VSFlexGrid1Ncc_AfterEdit(ByVal Row As Long, ByVal Col As Long) On Error GoTo loi With VSFlexGrid1Ncc If (.Col 0) And (.Cell(flexcpText, .RowSel, .ColSel) GuiTT) Then If MsgBox("Bạn có muốn lưu ô này vào trong CSDL hay không?", vbYesNo, "Thông báo") = vbNo Then .Cell(flexcpText, .RowSel, .ColSel) = GuiTT Exit Sub Else .Cell(flexcpForeColor, .RowSel, .ColSel) = vbRed End If End If End With loi: If Col = 0 Then MsgBox "Bạn không thể thay đổi dữ liệu trên cột này.", vbInformation, "Thông báo" With VSFlexGrid1Ncc .Cell(flexcpForeColor, .RowSel, .ColSel) = vbBlack End With Exit Sub End If End Sub Private Sub VSFlexGrid1Ncc_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean) With VSFlexGrid1Ncc GuiTT = .Cell(flexcpText, .RowSel, .ColSel) End With End Sub Private Sub VSFlexGrid1Ncc_EnterCell() 'Gọi thủ tục VaoO VaoO VSFlexGrid1Ncc, Label1 End Sub Private Sub VSFlexGrid1Ncc_LeaveCell() 'Gọi thủ tục RoiO RoikhoiO VSFlexGrid1Ncc End Sub Private Sub VSFlexGrid1Ncc_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Gọi thủ tục HienToolTip HienToolTipText VSFlexGrid1Ncc End Sub Private Sub VSFlexGrid1NccCtietSP_EnterCell() VaoO VSFlexGrid1NccCtietSP, Label1 End Sub Private Sub VSFlexGrid1NccCtietSP_LeaveCell() RoikhoiO VSFlexGrid1NccCtietSP End Sub Private Sub VSFlexGrid1NccCtietSP_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Gọi thủ tục hiện ToolTip HienToolTipText VSFlexGrid1NccCtietSP End Sub Option Explicit Private Sub cmdTimkiem_Click() On Error GoTo loi Dim SQLLocNCC As String If cboLocNCCma.Text = "Tất cả" Then SQLLocNCC = "Select * From tblNhacungcap" Else SQLLocNCC = "Select *" & _ " From tblNhacungcap" & _ " Where MaNhaCC=" & cboLocNCCma.Text & "" End If Ketnoi dataLocNCC, SQLLocNCC If dataLocNCC.Recordset.RecordCount = 0 Then MsgBox "Không tìm thấy nhà cung cấp có mã: " & cboLocNCCma.Text & "", vbInformation, "Thông báo" cboLocNCCma.SelStart = 0 cboLocNCCma.SelLength = Len(cboLocNCCma.Text) Exit Sub Else lblKQTK.Visible = True End If loi: End Sub Private Sub Form_Load() Dim SQL As String SQL = "Select MaNhaCC From tblNhacungcap" HienForm Me CauhinhLuoiPhu VSFlexGridNCCloc KhoitaoADODB SQL With cboLocNCCma .AddItem "Tất cả" End With With rsado Do While .EOF = False cboLocNCCma.AddItem .Fields("MaNhaCC").Value .MoveNext Loop .Close End With End Sub Option Explicit Private GuiTT As String Private Sub cboNuocNvbh_KeyPress(KeyAscii As Integer) PheChuanKeyPress cboNuocNvbh, KeyAscii If KeyAscii = 13 Then txtDthoaiNvbh.SetFocus End If End Sub Private Sub cboNuocNvbh_LostFocus() BuocphaidienDL cboNuocNvbh, True End Sub Private Sub cboTphoNvbh_KeyPress(KeyAscii As Integer) PheChuanKeyPress cboTphoNvbh, KeyAscii If KeyAscii = 13 Then cboVungNvbh.SetFocus End If End Sub Private Sub cboTphoNvbh_LostFocus() BuocphaidienDL cboTphoNvbh, True End Sub Private Sub cboVungNvbh_KeyPress(KeyAscii As Integer) PheChuanKeyPress cboVungNvbh, KeyAscii If KeyAscii = 13 Then txtMavungNvbh.SetFocus End If End Sub Private Sub cboVungNvbh_LostFocus() BuocphaidienDL cboVungNvbh, True End Sub Private Sub cmdChonhinh_Click() On Error GoTo loi With Hopthoai 'Thuộc tính này sẽ bẫy lỗi khi ta Cancel hộp thoại,tức là nếu 'ta qui định thuộc tính này là True thì lỗi sẽ xẩy ra nếu ta Cancel .CancelError = True .DialogTitle = "Chọn hình" .Filter = "JPG Files(*.jpg)|*.jpg|Bitmap Files(*.bmp)|*.bmp" .FilterIndex = 1 .MaxFileSize = 150 .InitDir = "C:\QLBH\Hinh" .

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

  • doc27566.DOC