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ự.
153 trang |
Chia sẻ: maiphuongdc | Lượt xem: 1439 | Lượt tải: 0
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:
- 27566.DOC