Báo cáo Thực tập tại phòng phần mềm thuộc Công ty đầu tư và phát triển phần mềm kế toán Asia

ad(Cancel As Integer) cnado.Close Set cnado = Nothing End Sub Option Explicit Private GuiTT As String Private Sub cdmNHomSPChonhinh_Click() On Error GoTo loi With HophinhNsp .CancelError = True .DialogTitle = "Chọn hình" .Filter = "JPG Files(*.jpg)|*.jpg|Bitmap Files(*.bmp)|*.bmp|All Files(*.*)|*.*" .FilterIndex = 1 .InitDir = "C:\QLKH\Hinh" .MaxFileSize = 150 .ShowOpen lblHinhanhNSP.Caption = "" & .FileName picNhomSPhinh.Picture = LoadPicture(.FileName) End With loi: End Sub Private Sub cmdLocnhanh_Click() frmNhomSPLoc.Show End Sub Private Sub cmdLuu_Click() 'Gọi thủ tục khởi tạo Controls lúc Luu DL KhoitaoControlsLucLuu Me With dataNhomhh .Recordset.Fields("MaNhom").Value = txtNhomSPMa.Text .Recordset.Fields("Tennhom").Value = txtNhomSPten.Text .Recordset.Fields("Mota").Value = rtxtNhomSPmota.Text .Recordset.Update .Refresh End With 'Gọi thủ tục Vohieuhoa dataNhomhh.Recordset.MoveLast Vohieuhoa Me End Sub Private Sub cmdThem_Click() Dim SQLMatudong As String SQLMatudong = "Select Max([MaNhom]) as Lonnhat From tblNhomhang" 'Gọi thủ tục khởi tạo Data kết nối cho txtNhomSPma Ketnoi dataMatudong, SQLMatudong dataMatudong.Refresh dataNhomhh.Recordset.AddNew 'Gọi hàm khởi tạo thuộc tính các Controls lúc thêm mới DL KhoitaoControlsLucThem Me If dataNhomhh.Recordset.RecordCount = 0 Then txtNhomSPMa.Text = "1" dataNhomhh.Caption = "1" Else With dataMatudong txtNhomSPMa.Text = "" & dataMatudong.Recordset.Fields("Lonnhat").Value + 1 dataNhomhh.Caption = "Nhóm: " & dataMatudong.Recordset.Fields("Lonnhat").Value + 1 End With End If txtNhomSPten.SetFocus lblTudong.Visible = True End Sub Private Sub cmdXoa_Click() If dataNhomhh.Recordset.RecordCount > 0 Then If dataNhomhangCTietHH.Recordset.RecordCount > 0 Then MsgBox "Bạn không thể xoá bản ghi này vì nó còn xuất hiện trên bảng con.", vbInformation, "Thông báo" Exit Sub Else 'Gọi thủ tục xoá dữ liệu Xoa dataNhomhh dataNhomhh.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 dataNhomhh_Reposition() On Error GoTo loi Dim SQLNhomhangCTietHH As String SQLNhomhangCTietHH = "Select *" & _ " From tblSanpham" & _ " Where NhomHHID=" & dataNhomhh.Recordset.Fields("MaNhom").Value & "" 'Gọi hàm khởi tạo Data kết nối cho luới chi tiết Ketnoi dataNhomhangCTietHH, SQLNhomhangCTietHH dataNhomhangCTietHH.Refresh 'Hiện thứ tự nhóm HH lên Caption của dataNhomHH With dataNhomhh .Caption = "Nhóm: " & dataNhomhh.Recordset.Fields("MaNhom").Value If IsNull(.Recordset.Fields("HinhNhom").Value) = False Then picNhomSPhinh.Picture = LoadPicture(.Recordset.Fields("HinhNhom").Value) lblKhongcohinh.Visible = False Else picNhomSPhinh.Picture = LoadPicture() lblKhongcohinh.Visible = True End If End With With VSFlexGrid1NhomHHChitiet .MergeCells = flexMergeRestrictColumns .MergeCol(3) = True End With loi: End Sub Private Sub Form_Load() Dim SQLNhomhang As String SQLNhomhang = "Select * From tblNhomhang" 'Gọi thủ tục khởi tạo Data kết nối Ketnoi dataNhomhh, SQLNhomhang 'Gọi thủ tục Vohieuhoa để vô hiệu hoá những điều khiển trên Form Vohieuhoa Me 'Gọi thủ tục HienForm HienForm Me 'Gọi thủ tục qui định thuộc tính cho lưới chính và lưới phụ CauhinhLuoiChinh VSFlexGrid1NhomHH CauhinhLuoiPhu VSFlexGrid1NhomHHChitiet End Sub Private Sub rtxtNhomSPmota_KeyPress(KeyAscii As Integer) PheChuanKeyPress rtxtNhomSPmota, KeyAscii If KeyAscii = 13 Then cmdLuu.SetFocus End If End Sub Private Sub rtxtNhomSPmota_LostFocus() BuocphaidienDL rtxtNhomSPmota, True End Sub Private Sub txtNhomSPMa_KeyPress(KeyAscii As Integer) 'Gọi thủ tục PhechuanKeypress PheChuanKeyPress txtNhomSPMa, KeyAscii If KeyAscii = 13 Then txtNhomSPten.SetFocus End If End Sub Private Sub txtNhomSPMa_LostFocus() BuocphaidienDL txtNhomSPMa, True End Sub Private Sub txtNhomSPten_KeyPress(KeyAscii As Integer) 'Gọi thủ tục PhechuanKeypress PheChuanKeyPress txtNhomSPten, KeyAscii If KeyAscii = 13 Then rtxtNhomSPmota.SetFocus End If End Sub Private Sub txtNhomSPten_LostFocus() BuocphaidienDL txtNhomSPten, True End Sub Private Sub VSFlexGrid1NhomHH_AfterEdit(ByVal Row As Long, ByVal Col As Long) On Error GoTo loi With VSFlexGrid1NhomHH If (.Col 0) And (.Cell(flexcpText, .RowSel, .ColSel) GuiTT) Then If MsgBox("Bạn có muốn xoá bản ghi này 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 VSFlexGrid1NhomHH .Cell(flexcpForeColor, .RowSel, .ColSel) = vbBlack End With Exit Sub End If End Sub Private Sub VSFlexGrid1NhomHH_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean) With VSFlexGrid1NhomHH GuiTT = .Cell(flexcpText, .RowSel, .ColSel) End With End Sub Private Sub VSFlexGrid1NhomHH_EnterCell() 'Gọi thủ tục VaoO VaoO VSFlexGrid1NhomHH, Label1 End Sub Private Sub VSFlexGrid1NhomHH_LeaveCell() 'Gọi thủ tục RoikhoiO RoikhoiO VSFlexGrid1NhomHH End Sub Private Sub VSFlexGrid1NhomHH_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Gọi thủ tục hiện ToolTipText HienToolTipText VSFlexGrid1NhomHH End Sub Private Sub VSFlexGrid1NhomHHChitiet_EnterCell() 'Gọi thủ tục VaoO VSFlexGrid1NhomHHChitiet, Label1 End Sub Private Sub VSFlexGrid1NhomHHChitiet_LeaveCell() 'Gọi thủ tục RoikhoiO VSFlexGrid1NhomHHChitiet End Sub Private Sub VSFlexGrid1NhomHHChitiet_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Gọi thủ tục HienToolTipText VSFlexGrid1NhomHHChitiet End Sub Private Sub cmdTimkiem_Click() On Error GoTo loi Dim SQLTimkiemNhomSP As String If cboTKMaNhomSP.Text = "Tất cả" Then SQLTimkiemNhomSP = "Select * From tblNhomhang" Else SQLTimkiemNhomSP = "Select *" & _ " From tblNhomhang" & _ " Where MaNhom=" & cboTKMaNhomSP.Text & "" End If Ketnoi dataTKNhomSP, SQLTimkiemNhomSP If dataTKNhomSP.Recordset.RecordCount = 0 Then MsgBox "Không tìm thấy nhóm sản phẩm có mã là: " & cboTKMaNhomSP.Text & "", vbInformation, "Thông báo" cboTKMaNhomSP.SelStart = 0 cboTKMaNhomSP.SelLength = Len(cboTKMaNhomSP.Text) Exit Sub Else lblKQTK.Visible = True End If loi: End Sub Private Sub Form_Load() Dim SQL As String SQL = "Select * From tblNhomhang" HienForm Me CauhinhLuoiPhu VSFlexGridNhomSPloc KhoitaoADODB SQL With cboTKMaNhomSP .AddItem "Tất cả" End With With rsado Do While .EOF = False cboTKMaNhomSP.AddItem .Fields("MaNhom").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 cmdDothi_Click() Unload Me frmDothi.Show End Sub Private Sub cmdQui1_Click() rptBCBHQui1.Show End Sub Private Sub cmdQui2_Click() rptBCBHQui2.Show End Sub Private Sub cmdQui3_Click() rptBCBHQui3.Show End Sub Private Sub cmdQui4_Click() rptBCBHQui4.Show End Sub Private Sub Form_Load() Me.Top = frmLienket.Top + frmLienket.tabLienket.Top + frmLienket.imgMuiten.Top Me.Left = frmLienket.Left + frmLienket.imgMuiten.Left - Me.Width End Sub Private Sub Form_Unload(Cancel As Integer) frmLienket.imgMuiten.Visible = False End Sub Option Explicit Private GuiTT As String Private Sub cmdLocnhanh_Click() frmSanphamLoc.Show End Sub Private Sub cmdLuu_Click() 'Gọi thủ tục khởi tạo lúc lưu KhoitaoControlsLucLuu Me With dataSanpham .Recordset.Fields("MaSP").Value = txtSPMa.Text .Recordset.Fields("TenSP").Value = txtSPTen.Text .Recordset.Fields("NhaCCID").Value = dbcboSPMaNCC.Text .Recordset.Fields("NhomHHID").Value = dbcboSPMaNhomHH.Text .Recordset.Fields("SoluongtrongDV").Value = txtSPSLTDV.Text .Recordset.Fields("Dongia").Value = meditSPDongia.Text .Recordset.Fields("SoDVtrongkho").Value = txtSPSDVTK.Text .Recordset.Fields("SoDVtrenHD").Value = txtSPSDVTHD.Text .Recordset.Fields("MucDMBS").Value = txtSPMDMBS.Text .Recordset.Fields("Dinhchi").Value = chkSanphamDchi.Value .Recordset.Update .Refresh End With 'Gọi thủ tục Vohieuhoa dataSanpham.Recordset.MoveLast Vohieuhoa Me End Sub Private Sub cmdThem_Click() Dim SQLMatudong As String SQLMatudong = "Select Max([MaSP]) as Lonnhat From tblSanpham" 'Gọi thủ tục tạo Data kết nối để tạo nguồn kết nối cho txtSPma Ketnoi dataMatudong, SQLMatudong dataMatudong.Refresh dataSanpham.Recordset.AddNew 'Gọi hàm để qui định thuộc tính các Controls lúc Thêm KhoitaoControlsLucThem Me If dataSanpham.Recordset.RecordCount = 0 Then txtSPMa.Text = "1" dataSanpham.Caption = "1" Else With dataMatudong txtSPMa.Text = "" & .Recordset.Fields("Lonnhat").Value + 1 dataSanpham.Caption = "SP thứ: " & .Recordset.Fields("Lonnhat").Value + 1 End With End If txtSPTen.SetFocus lblSPTenNCC.Caption = "" lblSPTennhomHH.Caption = "" lblTudong.Visible = True End Sub Private Sub cmdXoa_Click() If dataSanpham.Recordset.RecordCount > 0 Then If dataSanphamCTHD.Recordset.RecordCount > 0 Then MsgBox "Bạn không thể xoá bản ghi này vì nó còn xuất hiện trên bảng con.", vbInformation, "Thông báo" Exit Sub Else 'Gọi thủ tục xoá Xoa dataSanpham dataSanpham.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 dataSanpham_Reposition() On Error GoTo loi Dim SQLSanphamCTHD As String Dim SQLSanphamHienTenNCC As String Dim SQLSanphamHienTenNhomHH As String SQLSanphamCTHD = " Select *" & _ " From tblChitietHD" & _ " Where HanghoaID=" & dataSanpham.Recordset.Fields("MaSP").Value & "" SQLSanphamHienTenNCC = "Select TenCtyNcc" & _ " From tblNhacungcap" & _ " Where MaNhaCC=" & dataSanpham.Recordset.Fields("NhaCCID").Value & "" SQLSanphamHienTenNhomHH = "Select TenNhom" & _ " From tblNhomhang" & _ " Where MaNhom=" & dataSanpham.Recordset.Fields("NhomHHID").Value & "" 'Gọi thủ tục tạo Data kết nối để tạo nguồn kết nối cho lưới chi tiết Ketnoi dataSanphamCTHD, SQLSanphamCTHD dataSanphamCTHD.Refresh 'Gọi thủ tục tạo Data kết nối để tạo nguồn kết nối cho lblSpTenNCC Ketnoi dataSPHienTenNCC, SQLSanphamHienTenNCC dataSPHienTenNCC.Refresh lblSPTenNCC.Caption = "" & dataSPHienTenNCC.Recordset.Fields("TenCtyNcc").Value 'Gọi thủ tục tạo tạo Data kết nối để tạo nguồn kết nối cho lblSpTennhomHH Ketnoi dataSpHienTenNhomHH, SQLSanphamHienTenNhomHH dataSpHienTenNhomHH.Refresh lblSPTennhomHH.Caption = "" & dataSpHienTenNhomHH.Recordset.Fields("Tennhom").Value 'Hiện thứ tự hoá đơn lên Caption của Data With dataSanpham .Caption = "SP thứ: " & .Recordset.Fields("MaSP").Value End With With VSFlexGrid1CTSP .MergeCells = flexMergeRestrictColumns .MergeCol(2) = True End With loi: End Sub Private Sub dbcboSPMaNCC_Change() On Error GoTo loi If dbcboSPMaNCC.Text "" Then Dim SQLSpThaydoiMaNCC As String SQLSpThaydoiMaNCC = "Select TenCtyNcc" & _ " From tblNhacungcap" & _ " Where MaNhaCC=" & dbcboSPMaNCC.Text & "" 'Gọi thủ tục tạo Data để làm nguồn kết nối cho lblSpTenNCC Ketnoi dataSPThaydoiMaNCC, SQLSpThaydoiMaNCC dataSPThaydoiMaNCC.Refresh lblSPTenNCC.Caption = "" & dataSPThaydoiMaNCC.Recordset.Fields("TenCtyNcc").Value Else Exit Sub End If loi: End Sub Private Sub dbcboSPMaNCC_KeyPress(KeyAscii As Integer) PheChuanKeyPress dbcboSPMaNCC, KeyAscii If KeyAscii = 13 Then dbcboSPMaNhomHH.SetFocus End If End Sub Private Sub dbcboSPMaNCC_LostFocus() BuocphaidienDL dbcboSPMaNCC, True End Sub Private Sub dbcboSPMaNhomHH_Change() On Error GoTo loi If dbcboSPMaNhomHH.Text "" Then Dim SQLSPThaydoiManhomHH As String SQLSPThaydoiManhomHH = "Select Tennhom" & _ " From tblNhomhang" & _ " Where MaNhom=" & dbcboSPMaNhomHH.Text & "" 'Gọi thủ tục tạo Data để làm nguồn kết nối cho lblSpTennhomHH Ketnoi dataSPThaydoiMaNhomHH, SQLSPThaydoiManhomHH dataSPThaydoiMaNhomHH.Refresh lblSPTennhomHH.Caption = "" & dataSPThaydoiMaNhomHH.Recordset.Fields("Tennhom").Value Else Exit Sub End If loi: End Sub Private Sub dbcboSPMaNhomHH_KeyPress(KeyAscii As Integer) PheChuanKeyPress dbcboSPMaNhomHH, KeyAscii If KeyAscii = 13 Then txtSPSLTDV.SetFocus End If End Sub Private Sub dbcboSPMaNhomHH_LostFocus() BuocphaidienDL dbcboSPMaNhomHH, True End Sub Private Sub Form_Load() Dim SQLSanpham As String SQLSanpham = "Select * From tblSanpham Order By NhaCCID,NhomHHID" 'Gọi thủ tục để vô hiệu hoá những điều khiển không cho phép sửa đổi trên Form Vohieuhoa Me 'Gọi thủ tục thể 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 dataSanpham, SQLSanpham 'Gọi thủ tục định dạng lưới optTron(1).Value = True CauhinhLuoiChinh VSFlexGrid1SP CauhinhLuoiPhu VSFlexGrid1CTSP End Sub Private Sub meditSPDongia_KeyPress(KeyAscii As Integer) PheChuanKeyPress meditSPDongia, KeyAscii If KeyAscii = 13 Then txtSPSDVTK.SetFocus End If End Sub Private Sub meditSPDongia_LostFocus() BuocphaidienDL meditSPDongia, True End Sub Private Sub optTron_Click(Index As Integer) Select Case Index Case 0 optTron(1).Value = False With VSFlexGrid1SP .MergeCells = flexMergeRestrictColumns .MergeCol(2) = True End With Case 1 optTron(0).Value = False With VSFlexGrid1SP .MergeCells = flexMergeNever End With End Select End Sub Private Sub txtSPDongia_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtSPDongia, KeyAscii If KeyAscii = 13 Then txtSPSDVTK.SetFocus End If End Sub Private Sub txtSPMa_KeyPress(KeyAscii As Integer) 'Gọi thủ tục PheChuanKeypress PheChuanKeyPress txtSPMa, KeyAscii If KeyAscii = 13 Then txtSPTen.SetFocus End If End Sub Private Sub txtSPMDMBS_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtSPMDMBS, KeyAscii If KeyAscii = 13 Then chkSanphamDchi.SetFocus End If End Sub Private Sub txtSPMDMBS_LostFocus() BuocphaidienDL txtSPMDMBS, True End Sub Private Sub txtSPSDVTHD_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtSPSDVTHD, KeyAscii If KeyAscii = 13 Then txtSPMDMBS.SetFocus End If End Sub Private Sub txtSPSDVTHD_LostFocus() BuocphaidienDL txtSPSDVTHD, True End Sub Private Sub txtSPSDVTK_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtSPSDVTK, KeyAscii If KeyAscii = 13 Then txtSPSDVTHD.SetFocus End If End Sub Private Sub txtSPSDVTK_LostFocus() BuocphaidienDL txtSPSDVTK, True End Sub Private Sub txtSPSLTDV_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtSPSLTDV, KeyAscii If KeyAscii = 13 Then meditSPDongia.SetFocus End If End Sub Private Sub txtSPSLTDV_LostFocus() BuocphaidienDL txtSPSLTDV, True End Sub Private Sub txtSPTen_KeyPress(KeyAscii As Integer) PheChuanKeyPress txtSPTen, KeyAscii If KeyAscii = 13 Then dbcboSPMaNCC.SetFocus End If End Sub Private Sub txtSPTen_LostFocus() BuocphaidienDL txtSPTen, True End Sub Private Sub VSFlexGrid1CTSP_EnterCell() 'Gọi thủ tục VaoO VSFlexGrid1CTSP, Label1 End Sub Private Sub VSFlexGrid1CTSP_LeaveCell() 'Gọi thủ tục RoikhoiO VSFlexGrid1CTSP End Sub Private Sub VSFlexGrid1CTSP_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Gọi thủ tục HienToolTipText VSFlexGrid1CTSP End Sub Private Sub VSFlexGrid1SP_AfterEdit(ByVal Row As Long, ByVal Col As Long) On Error GoTo loi With VSFlexGrid1SP If (.Col 0) And (.Cell(flexcpText, .RowSel, .ColSel) GuiTT) Then If MsgBox("Bạn có muốn lưu sự thay đổi 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 "Ô này không cho phép thay đổi dữ liệu,Vì dữ liệu của nó còn xuất hiện trên bảng con.", vbInformation, "Thông báo" VSFlexGrid1SP.Cell(flexcpForeColor, VSFlexGrid1SP.RowSel, VSFlexGrid1SP.ColSel) = vbBlack Exit Sub End If End Sub Private Sub VSFlexGrid1SP_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean) With VSFlexGrid1SP GuiTT = .Cell(flexcpText, .RowSel, .ColSel) End With End Sub Private Sub VSFlexGrid1SP_EnterCell() 'Gọi thủ tục VaoO VaoO VSFlexGrid1SP, Label1 End Sub Private Sub VSFlexGrid1SP_LeaveCell() 'Gọi thủ tục RoikhoiO RoikhoiO VSFlexGrid1SP End Sub Private Sub VSFlexGrid1SP_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Gọi thủ tục HienToolTipText HienToolTipText VSFlexGrid1SP End Sub Option Explicit Private Sub cmdTimkiem_Click() On Error GoTo loi Dim SQLTimkiemSP As String If cboTKMaSP.Text = "Tất cả" Then SQLTimkiemSP = "Select * From tblSanpham" Else SQLTimkiemSP = "Select *" & _ " From tblSanpham" & _ " Where MaSP=" & cboTKMaSP.Text & "" End If Ketnoi dataTKSanpham, SQLTimkiemSP dataTKSanpham.Refresh If dataTKSanpham.Recordset.RecordCount = 0 Then MsgBox "Không tìm thấy sản phẩm có mã " & cboTKMaSP.Text & "", vbInformation, "Thông báo" cboTKMaSP.SelStart = 0 cboTKMaSP.SelLength = Len(cboTKMaSP.Text) Exit Sub Else lblKQTK.Visible = True End If loi: End Sub Private Sub Form_Load() Dim SQL As String SQL = "Select MaSP From tblSanpham" HienForm Me CauhinhLuoiPhu VSFlexGridSanphamloc With cboTKMaSP .AddItem "Tất cả" End With KhoitaoADODB SQL With rsado Do While .EOF = False cboTKMaSP.AddItem .Fields("MaSP").Value .MoveNext Loop .Close End With End Sub Private Sub Form_Unload(Cancel As Integer) cnado.Close Set cnado = Nothing End Sub Option Explicit 'Khai báo các đối tượng ActiveX do Excel cung cấp Dim Active_Excel As Object Dim Active_Workbook As Object Dim Active_Worksheet As Object Private Sub DienDLlenExcel(ByVal dong As Integer, ByVal cot As Integer, ByVal Dulieu As String) On Error GoTo loi With Active_Worksheet.Cells(dong, cot) .Value = Dulieu .Font.Name = ".vnTime" .Font.Size = 10 .Font.Bold = True End With loi: End Sub Private Sub cmdXemTruoc_Click(Index As Integer) If Index = 0 Then frmBaocaotonghop.Show ElseIf Index = 1 Then frmLienket.lblChuthichTH.Visible = True frmLienket.lblChuthichTH.Caption = "Hãy đợi một tí,chương trình đang nạp..." Screen.MousePointer = 99 Screen.MouseIcon = LoadPicture("C:\QLKH\GRAPHICS\CURSORS\Wait07.cur") Dim SQLExcel As String SQLExcel = "Select Ten,Ho,NgayHD,HanghoaID,Soluong,Dongia,tblChitietHD.[Soluong]*tblChitietHD.[Dongia] as Thanhtien" & _ " From tblNhanvienbanhang,tblHoadon,tblChitietHD" & _ " Where tblNhanvienbanhang.[MaNBan]=tblHoadon.[NguoibanID]" & _ " And tblHoadon.[MaHD]=tblChitietHD.[HoadonID]" & _ " Order By Ten,Ho,NgayHD" KhoitaoADODB SQLExcel 'Tạo dòng tiêu đề With rsado If rsado.RecordCount = 0 Then MsgBox "Không có dữ liêu để đưa lên Excel", vbInformation, "Thông báo" Else DienDLlenExcel 1, 1, "Họ nhân viên" DienDLlenExcel 1, 2, "Tên nhân viên" DienDLlenExcel 1, 3, "Ngày hoá đơn" DienDLlenExcel 1, 4, "Mã hàng" DienDLlenExcel 1, 5, "Số lượng" DienDLlenExcel 1, 6, "Đơn giá" DienDLlenExcel 1, 7, "Thành tiền" 'Đưa dữ liệu lên bảng Dim Donghienthoi As Integer Donghienthoi = 2 Do While .EOF = False DienDLlenExcel Donghienthoi, 1, .Fields("Ho").Value DienDLlenExcel Donghienthoi, 2, .Fields("Ten").Value DienDLlenExcel Donghienthoi, 3, Left$(.Fields("NgayHD").Value, 8) DienDLlenExcel Donghienthoi, 4, .Fields("HanghoaID").Value DienDLlenExcel Donghienthoi, 5, .Fields("Soluong").Value DienDLlenExcel Donghienthoi, 6, "$" & .Fields("Dongia").Value DienDLlenExcel Donghienthoi, 7, "$" & .Fields("Thanhtien").Value .MoveNext Donghienthoi = Donghienthoi + 1 Loop End If .Close End With Active_Excel.Visible = True Screen.MousePointer = 0 frmLienket.lblChuthichTH.Visible = False End If End Sub Private Sub Form_Load() 'Thực sự tạo ra các đối tượng ActiveX do Excel cung cấp Set Active_Excel = CreateObject("Excel.Application") Set Active_Workbook = Active_Excel.Workbooks.Add Set Active_Worksheet = Active_Workbook.Worksheets.Add Me.Top = frmLienket.Top + frmLienket.tabLienket.Top + frmLienket.imgMuiten2.Top Me.Left = frmLienket.Left + frmLienket.imgMuiten2.Left - Me.Width End Sub Private Sub Form_Unload(Cancel As Integer) On Error GoTo loi frmLienket.imgMuiten2.Visible = False cnado.Close Set cnado = Nothing Set Active_Excel = Nothing Set Active_Workbook = Nothing Set Active_Worksheet = Nothing loi: End Sub Option Explicit Private Sub cboTinhtoan_Change() If cboTinhtoan.Text = "Phần trăm" Then With VSFlexGrid1Tree .Subtotal flexSTClear .Subtotal flexSTPercent, 0, 6, "%", &HFFC0C0, vbBlack, True, "Phần trăm" End With End If If cboTinhtoan.Text = "Tổng" Then With VSFlexGrid1Tree .Subtotal flexSTClear .Subtotal flexSTSum, 0, 6, "$", &HFFC0C0, vbBlack, True, "Tổng" End With End If End Sub Private Sub chkCay_Click() Dim i As Integer For i = 0 To 3 With VSFlexGrid1Tree(i) If chkCay.Value = False Then .OutlineBar = flexOutlineBarNone Else .OutlineBar = flexOutlineBarComplete End If End With Next End Sub Private Sub chkLuoi_Click() Dim i As Integer For i = 0 To 3 With VSFlexGrid1Tree(i) If chkLuoi.Value = False Then .GridLines = flexGridNone Else .GridLines = flexGridFlat End If End With Next i With VSFlexGrid1Duyet If chkLuoi.Value = False Then .GridLines = flexGridNone Else .GridLines = flexGridFlat End If End With End Sub Private Sub chkNen_Click() Dim i As Integer For i = 0 To 3 With VSFlexGrid1Tree(i) If chkNen.Value = False Then .WallPaper = LoadPicture() Else .WallPaper = imgNen .WallPaperAlignment = flexPicAlignCenterCenter End If End With Next i With VSFlexGrid1Duyet If chkNen.Value = False Then .WallPaper = Nothing Else .WallPaper = imgNen .WallPaperAlignment = flexPicAlignCenterCenter End If End With End Sub Private Sub Form_Load() HienForm Me optMucdich(0).Value = True CauhinhLuoiPhu VSFlexGrid1Duyet With cboTinhtoan .AddItem "Tổng" .AddItem "Phần trăm" .AddItem "Nhỏ nhất" .AddItem "Lớn nhất" .AddItem "Trung bình" .AddItem "Phương sai" .AddItem "Độ lệch chuẩn" .AddItem "Đếm" .AddItem "Không" .ListIndex = 0 End With End Sub Private Sub Form_Unload(Cancel As Integer) cnado.Close Set cnado = Nothing End Sub Private Sub optMucdich_Click(Index As Integer) On Error GoTo loi Dim SQLTree As String Dim NewNode As Node Dim SQLDuyet As String Dim dong As Integer Dim cot As Integer dong = 1 Select Case Index '--------------------------------------------------------------- Case 0 Me.TreeView1.Nodes.Clear Set NewNode = Me.TreeView1.Nodes.Add(, tvwRootLines, "a", "Nhân viên BH", 1) SQLDuyet = "Select Ho,Ten From tblNhanvienbanhang Order By Ho" KhoitaoADODB SQLDuyet With rsado Do Until .EOF = True Set NewNode = Me.TreeView1.Nodes.Add("a", tvwChild, , .Fields("Ten").Value, 2, 3) .MoveNext Loop .Close End With 'Phần hiện lên lưới Tree VSFlexGrid1Tree(0).Visible = True VSFlexGrid1Tree(1).Visible = False VSFlexGrid1Tree(2).Visible = False VSFlexGrid1Tree(3).Visible = False SQLTree = "Select Ten,Ho,NgayHD,HanghoaID,Soluong,Dongia,tblChitietHD.[Soluong]*tblChitietHD.[Dongia] as Thanhtien" & _ " From tblNhanvienbanhang,tblHoadon,tblChitietHD" & _ " Where tblNhanvienbanhang.[MaNBan]=tblHoadon.[NguoibanID]" & _ " And tblHoadon.[MaHD]=tblChitietHD.[HoadonID]" & _ " Order By Ten" KhoitaoADODB SQLTree With VSFlexGrid1Tree(0) .FormatString = " |Tên|<Họ|Ngày HĐ|Mã hàng|Số lượng|Đơn giá|Thành tiền" .ColWidth(0) = 2000 .ColWidth(1) = 2000 .ColWidth(2) = 2000 .ColWidth(3) = 2000 End With Do Until rsado.EOF = True With VSFlexGrid1Tree(0) .Cell(flexcpPicture, dong, 3) = LoadPicture("C:\QLKH\GRAPHICS\ICONS\FLAGS\Flgbrazl.Ico") .Cell(flexcpText, dong, 1) = rsado.Fields("Ten").Value .Cell(flexcpText, dong, 2) = rsado.Fields("Ho").Value .Cell(flexcpText, dong, 3) = CStr(Left$(rsado.Fields("NgayHD").Value, 8)) .Cell(flexcpText, dong, 4) = CStr(rsado.Fields("HanghoaID").Value) .Cell(flexcpText, dong, 5) = CStr(rsado.Fields("Soluong").Value) .Cell(flexcpText, dong, 6) = CStr(rsado.Fields("Dongia").Value) .Cell(flexcpText, dong, 7) = CStr(rsado.Fields("Thanhtien").Value) dong = dong + 1 rsado.MoveNext End With Loop rsado.Close With VSFlexGrid1Tree(0) .OutlineCol = 0 .OutlineBar = flexOutlineBarComplete .SubtotalPosition = flexSTAbove .Subtotal flexSTClear .Subtotal flexSTSum, 0, 7, "$,", &HFFC0C0, vbRed, True, "Tổng toàn bộ" .Subtotal flexSTSum, 1, 7, "$,", &HFFC0C0, vbBlack, True, "Tổng theo tên" .Subtotal flexSTSum, 2, 7, "$", &HFFC0C0, vbBlack, True, "Tổng theo họ" .Subtotal flexSTSum, 3, 7, "$", &HFFC0C0, vbBlack, True, "Tổng theo ngày" .MergeCells = flexMergeRestrictColumns .MergeCol(0) = True .MergeCol(1) = True .MergeCol(2) = True .MergeCol(3) = True End With optMucdich(1).Value = False optMucdich(2).Value = False optMucdich(3).Value = False '--------------------------------------------------------------- Case 1 Me.TreeView1.Nodes.Clear Set NewNode = Me.TreeView1.Nodes.Add(, tvwRootLines, "a", "Nhà cung cấp", 1) SQLDuyet = "Select * From tblNhacungcap Order by TenCtyNCC" KhoitaoADODB SQLDuyet With rsado Do While .EOF = False Set NewNode = Me.TreeView1.Nodes.Add("a", tvwChild, , .Fields("TenCtyNcc").Value, 2, 3) .MoveNext Loop .Close End With 'Phần hiện lên lưới Tree VSFlexGrid1Tree(0).Visible = False VSFlexGrid1Tree(1).Visible = True VSFlexGrid1Tree(2).Visible = False VSFlexGrid1Tree(3).Visible = False SQLTree = "Select TenCtyNcc,TenSP,Soluong,tblChitietHD.[Dongia],[Soluong]*tblChitietHD.[Dongia] as Thanhtien" & _ " From tblNhacungcap,tblSanpham,tblChitietHD" & _ " Where tblNhacungcap.[MaNhaCC]=tblSanpham.[NhaCCID]" & _ " And tblSanpham.[MaSP]=tblChitietHD.[HanghoaID]" & _ " Order By TenCtyNcc" KhoitaoADODB SQLTree With VSFlexGrid1Tree(1) .FormatString = " |Tên nhà cung cấp|Tên sản phẩm|Số lượng|Đơn giá|Thành tiền" .ColWidth(0) = 2000 .ColWidth(1) = 4000 .ColWidth(2) = 2000 End With Do While rsado.EOF = False With VSFlexGrid1Tree(1) .Cell(flexcpPicture, dong, 2) = LoadPicture("C:\QLKH\GRAPHICS\ICONS\INDUSTRY\Bicycle.ico") .Cell(flexcpText, dong, 1) = rsado.Fields("TenCtyNcc").Value .Cell(flexcpText, dong, 2) = rsado.Fields("TenSp").Value .Cell(flexcpText, dong, 3) = CStr(rsado.Fields("Soluong").Value) .Cell(flexcpText, dong, 4) = CStr(rsado.Fields("Dongia").Value) .Cell(flexcpText, dong, 5) = CStr(rsado.Fields("Thanhtien").Value) dong = dong + 1 rsado.MoveNext End With Loop rsado.Close With VSFlexGrid1Tree(1) .OutlineCol = 0 .OutlineBar = flexOutlineBarComplete .SubtotalPosition = flexSTAbove .Subtotal flexSTClear .Subtotal flexSTSum, 0, 5, "$", &HFFC0C0, vbRed, True, "Tổng toàn bộ" .Subtotal flexSTSum, 1, 5, "$", &HFFC0C0, vbBlack, True, "Tổng theo NCC" .Subtotal flexSTSum, 2, 5, "$", &HFFC0C0, vbBlack, True, "Tổng theo hàng" .MergeCells = flexMergeRestrictColumns .MergeCol(0) = True .MergeCol(1) = True .MergeCol(2) = True End With VSFlexGrid1Duyet.Visible = False lblDuyet.Visible = False lblChuthich.Visible = False picHinhanh.Visible = False optMucdich(0).Value = False optMucdich(2).Value = False optMucdich(3).Value = False Case 2 Me.TreeView1.Nodes.Clear Set NewNode = Me.TreeView1.Nodes.Add(, tvwRootLines, "a", "Nhóm hàng hoá", 1) SQLDuyet = "Select * From tblNhomhang Order by TenNhom" KhoitaoADODB SQLDuyet With rsado Do Until .EOF = True Set NewNode = Me.TreeView1.Nodes.Add("a", tvwChild, , .Fields("Tennhom").Value, 2, 3) .MoveNext Loop .Close End With 'Hiện lên lưới Tree VSFlexGrid1Tree(0).Visible = False VSFlexGrid1Tree(1).Visible = False VSFlexGrid1Tree(2).Visible = True VSFlexGrid1Tree(3).Visible = False '======================== SQLTree = "Select TenNhom,TenSP,Soluong,tblChitietHD.[Dongia],Soluong*tblChitietHD.[Dongia] as Thanhtien" & _ " From tblNhomhang,tblSanpham,tblChitietHD" & _ " Where tblNhomhang.[Manhom]=tblSanpham.[NhomHHID]" & _ " And tblSanpham.[MaSP]=tblChitietHD.[HanghoaID]" & _ " Order By TenNhom" KhoitaoADODB SQLTree With VSFlexGrid1Tree(2) .FormatString = " |Tên nhóm hàng|Tên sản phẩm|Số lượng|Đơn giá|Thành tiền" .ColWidth(0) = 2000 .ColWidth(1) = 3000 .ColWidth(2) = 2000 End With Do Until rsado.EOF = True With VSFlexGrid1Tree(2) .Cell(flexcpPicture, dong, 2) = LoadPicture("C:\QLKH\GRAPHICS\ICONS\MISC\Mike.Ico") .Cell(flexcpText, dong, 1) = rsado.Fields("TenNhom").Value .Cell(flexcpText, dong, 2) = rsado.Fields("TenSP").Value .Cell(flexcpText, dong, 3) = CStr(rsado.Fields("Soluong").Value) .Cell(flexcpText, dong, 4) = CStr(rsado.Fields("Dongia").Value) .Cell(flexcpText, dong, 5) = CStr(rsado.Fields("Thanhtien").Value) dong = dong + 1 rsado.MoveNext End With Loop rsado.Close With VSFlexGrid1Tree(2) .OutlineCol = 0 .OutlineBar = flexOutlineBarComplete .SubtotalPosition = flexSTAbove .Subtotal flexSTClear .Subtotal flexSTSum, 0, 5, "$", &HFFC0C0, vbRed, True, "Tổng toàn bộ" .Subtotal flexSTSum, 1, 5, "$", &HFFC0C0, vbBlack, True, "Tổng theo nhóm hàng" .Subtotal flexSTSum, 2, 5, "$", &HFFC0C0, vbBlack, True, "Tổng theo hàng" .MergeCells = flexMergeRestrictColumns .MergeCol(0) = True .MergeCol(1) = True .MergeCol(2) = True End With VSFlexGrid1Duyet.Visible = False lblDuyet.Visible = False lblChuthich.Visible = False picHinhanh.Visible = False optMucdich(0).Value = False optMucdich(1).Value = False optMucdich(3).Value = False Case Else Me.TreeView1.Nodes.Clear Set NewNode = Me.TreeView1.Nodes.Add(, tvwRootLines, "a", "Hàng hoá", 1) SQLDuyet = "Select * From tblSanpham Order by TenSP" KhoitaoADODB SQLDuyet With rsado Do While .EOF = False Set NewNode = Me.TreeView1.Nodes.Add("a", tvwChild, , .Fields("TenSP").Value, 2, 3) .MoveNext Loop .Close End With 'Hiên lên lưới tree VSFlexGrid1Tree(0).Visible = False VSFlexGrid1Tree(1).Visible = False VSFlexGrid1Tree(2).Visible = False VSFlexGrid1Tree(3).Visible = True '============================== SQLTree = " Select TenSP,Soluong,tblChitietHD.[Dongia],Soluong*tblChitietHD.[Dongia] as Thanhtien" & _ " From tblSanpham,tblChitietHD" & _ " Where tblSanpham.[MaSP]=tblChitietHD.[HanghoaID]" & _ " Order By TenSP" KhoitaoADODB SQLTree With VSFlexGrid1Tree(3) .FormatString = " |Tên sản phẩm|Số lượng|Đơn giá|Thành tiền" .ColWidth(0) = 2000 .ColWidth(1) = 2000 End With Do Until rsado.EOF = True With VSFlexGrid1Tree(3) .Cell(flexcpPicture, dong, 1) = LoadPicture("C:\QLKH\GRAPHICS\ICONS\MISC\Clock05.Ico") .Cell(flexcpText, dong, 1) = rsado.Fields("TenSP").Value .Cell(flexcpText, dong, 2) = CStr(rsado.Fields("Soluong").Value) .Cell(flexcpText, dong, 3) = CStr(rsado.Fields("Dongia").Value) .Cell(flexcpText, dong, 4) = CStr(rsado.Fields("Thanhtien").Value) dong = dong + 1 rsado.MoveNext End With Loop rsado.Close With VSFlexGrid1Tree(3) .OutlineCol = 0 .OutlineBar = flexOutlineBarComplete .SubtotalPosition = flexSTAbove .Subtotal flexSTClear .Subtotal flexSTSum, 0, 4, "$", &HFFC0C0, vbRed, True, "Tổng toàn bộ" .Subtotal flexSTSum, 1, 4, "$", &HFFC0C0, vbBlack, True, "Tổng theo hàng" .MergeCells = flexMergeRestrictColumns .MergeCol(0) = True .MergeCol(1) = True End With VSFlexGrid1Duyet.Visible = False lblDuyet.Visible = False lblChuthich.Visible = False picHinhanh.Visible = False optMucdich(0).Value = False optMucdich(1).Value = False optMucdich(2).Value = False End Select loi: End Sub Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node) 'On Error GoTo loi Dim SQLChitietDuyet As String Dim i As Integer Dim Duongdanhinh As String Dim SQLHinhanh As String If optMucdich(0).Value = True Then If Node.Key = "a" Then VSFlexGrid1Duyet.Visible = False lblDuyet.Visible = False lblChuthich.Visible = False picHinhanh.Visible = False Exit Sub Else VSFlexGrid1Duyet.Visible = True lblDuyet.Visible = True picHinhanh.Visible = True SQLHinhanh = "Select Hinhanh" & _ " From tblNhanvienbanhang" & _ " Where Ten='" & Node.Text & "'" KhoitaoADODB SQLHinhanh With rsado If IsNull(.Fields("Hinhanh").Value) = False Then picHinhanh.Picture = LoadPicture(.Fields("Hinhanh").Value) Else picHinhanh.Picture = LoadPicture() End If .Close End With SQLChitietDuyet = "Select Ho,Ten,NgayHD,Cuocphi,Soluong,Dongia,Trietkhau" & _ " From tblNhanvienbanhang,tblHoadon,tblChitietHD" & _ " Where tblNhanvienbanhang.[MaNBan]=tblHoadon.[NguoibanID]" & _ " And tblHoadon.[MaHD]=tblChitietHD.[HoadonID]" & _ " And Ten='" & Node.Text & "'" Ketnoi dataDuyet, SQLChitietDuyet If dataDuyet.Recordset.RecordCount = 0 Then lblChuthich.Visible = True Exit Sub Else lblChuthich.Visible = False End If With VSFlexGrid1Duyet .MergeCells = flexMergeRestrictColumns For i = 0 To 1 .MergeCol(i) = True .Cell(flexcpBackColor, 1, i) = &HC0E0FF Next i End With End If End If '--------------------------------------------------------------------------------- If Node.Key = "a" Then lblDuyet.Visible = False lblChuthich.Visible = False VSFlexGrid1Duyet.Visible = False picHinhanh.Visible = False Exit Sub Else lblDuyet.Visible = True VSFlexGrid1Duyet.Visible = True '---------------------------------------------------------------------------- If optMucdich(1).Value = True Then SQLChitietDuyet = "Select TenCtyNcc,TenSP,tblChitietHD.[Dongia],Soluong,Trietkhau" & _ " From tblNhacungcap,tblSanpham,tblChitietHD" & _ " Where tblNhacungcap.[MaNhaCC]=tblSanpham.[NhaCCID]" & _ " And tblSanpham.[MaSP]=tblChitietHD.[HanghoaID]" & _ " And TenCtyNcc='" & Node.Text & "'" Ketnoi dataDuyet, SQLChitietDuyet If dataDuyet.Recordset.RecordCount = 0 Then lblChuthich.Visible = True Exit Sub Else lblChuthich.Visible = False End If With VSFlexGrid1Duyet .MergeCells = flexMergeRestrictColumns .MergeCol(0) = True .Cell(flexcpBackColor, 1, 0) = &HC0E0FF End With End If '---------------------------------------------------------------------------- If optMucdich(2).Value = True Then SQLChitietDuyet = "Select TenNhom,TenSP,tblChitietHD.[Dongia],Soluong,Trietkhau" & _ " From tblNhomhang,tblSanpham,tblChitietHD" & _ " Where tblNhomhang.[Manhom]=tblSanpham.[NhomHHID]" & _ " And tblSanpham.[MaSP]=tblChitietHD.[HanghoaID]" & _ " And TenNhom='" & Node.Text & "'" Ketnoi dataDuyet, SQLChitietDuyet If dataDuyet.Recordset.RecordCount = 0 Then lblChuthich.Visible = True Exit Sub Else lblChuthich.Visible = False End If With VSFlexGrid1Duyet .MergeCells = flexMergeRestrictColumns .MergeCol(0) = True .Cell(flexcpBackColor, 1, 0) = &HC0E0FF End With End If '---------------------------------------------------------------------------- If optMucdich(3).Value = True Then SQLChitietDuyet = "Select TenSP,tblChitietHD.[Dongia],Soluong,Trietkhau" & _ " From tblSanpham" & _ " Inner Join tblChitietHD" & _ " On tblSanpham.[MaSP]=tblChitietHD.[HanghoaID]" & _ " Where TenSP='" & Node.Text & "'" Ketnoi dataDuyet, SQLChitietDuyet If dataDuyet.Recordset.RecordCount = 0 Then lblChuthich.Visible = True Exit Sub Else lblChuthich.Visible = False End If With VSFlexGrid1Duyet .MergeCells = flexMergeRestrictColumns .MergeCol(0) = True .Cell(flexcpBackColor, 1, 0) = &HC0E0FF End With End If End If 'loi: End Sub Private Sub VSFlexGrid1Duyet_EnterCell() With VSFlexGrid1Duyet .Cell(flexcpPicture, .RowSel, .ColSel) = Image3 End With End Sub Private Sub VSFlexGrid1Duyet_LeaveCell() With VSFlexGrid1Duyet .Cell(flexcpPicture, .RowSel, .ColSel) = Nothing End With End Sub Private Sub VSFlexGrid1Tree_EnterCell(Index As Integer) Select Case Index Case 0 With VSFlexGrid1Tree(Index) If .ColSel 3 Then .Cell(flexcpPicture, .RowSel, .ColSel) = Image3 Else '.Cell(flexcpPicture, .RowSel, .ColSel) = LoadPicture("C:\QLKH\GRAPHICS\ICONS\FLAGS\Flgbrazl.Ico") End If End With Case 1 With VSFlexGrid1Tree(Index) If .ColSel 2 Then .Cell(flexcpPicture, .RowSel, .ColSel) = Image3 Else '.Cell(flexcpPicture, .RowSel, .ColSel) = LoadPicture("C:\QLKH\GRAPHICS\ICONS\INDUSTRY\Bicycle.ico") End If End With Case 2 With VSFlexGrid1Tree(Index) If .ColSel 2 Then .Cell(flexcpPicture, .RowSel, .ColSel) = Image3 Else '.Cell(flexcpPicture, .RowSel, .ColSel) = LoadPicture("C:\QLKH\GRAPHICS\ICONS\MISC\Mike.Ico") End If End With Case 3 With VSFlexGrid1Tree(Index) If .ColSel 1 Then .Cell(flexcpPicture, .RowSel, .ColSel) = Image3 Else '.Cell(flexcpPicture, .RowSel, .ColSel) = LoadPicture("C:\QLKH\GRAPHICS\ICONS\MISC\Clock05.Ico") End If End With End Select End Sub Private Sub VSFlexGrid1Tree_LeaveCell(Index As Integer) Select Case Index Case 0 With VSFlexGrid1Tree(Index) If .ColSel 3 Then .Cell(flexcpPicture, .RowSel, .ColSel) = LoadPicture() Else Exit Sub End If End With Case 1, 2 With VSFlexGrid1Tree(Index) If .ColSel 2 Then .Cell(flexcpPicture, .RowSel, .ColSel) = LoadPicture() Else Exit Sub End If End With Case Else With VSFlexGrid1Tree(Index) If .ColSel 1 Then .Cell(flexcpPicture, .RowSel, .ColSel) = LoadPicture() Else Exit Sub End If End With End Select End Sub Option Explicit Private Sub cmdXemDL_Click() On Error GoTo loi With comdXemDL .CancelError = True .DialogTitle = "Chọn tệp backup để xem" .Filter = "Text Files(*.txt)|*.txt|All Files(*.*)|*.*" .FilterIndex = 1 .MaxFileSize = 200 .InitDir = "C:\QLKH\Backup" .ShowOpen VSFlexGrid1XemDL.LoadGrid .FileName, flexFileAll End With loi: End Sub Private Sub cmdXemDL_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) lblThongbao.Visible = True imgMuiten.Visible = True End Sub Private Sub Form_Load() HienForm Me End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) lblThongbao.Visible = False imgMuiten.Visible = False End Sub Option Explicit 'Khai báo hai biến tiếp cận dữ liệu. Public cnado As New ADODB.Connection Public rsado As New ADODB.Recordset 'Ta định nghĩa một thủ tục kiểm tra giá trị nhập vào các Textbox 'Trong thủ tục có hai tham số DieuKhien:chỉ điều khiển cần nhập 'nKeyAscii:chỉ mã Ascii của ký tự được nhập Public Sub PheChuanKeyPress(Dieukhien As Control, nKeyAscii As Integer) Dim sMaxLength As String 'Biến này dùng để chứa chuỗi con của thuộc tính Tag của điều khiển Dim sKey As String * 1 'Biến này dùng để chứa ký tự được nhập vào từ bàn phím vào trong điều 'khiển If nKeyAscii 126 Then 'Kiểm tra nếu ký tự nhập vào là các phím đặc biệt trên bàn phím 'thì thoát khỏi thủ tục Beep Exit Sub Else: sMaxLength = Right$(Dieukhien.Tag, Len(Dieukhien.Tag) - 1) 'TH còn lại thì gán chuỗi con lấy từ thuộc tính Tag của điều khiển 'trừ ký tự đầu tiên cho biến sMaxLength(chính là số ký tự được nhập 'Vào điều khiển) End If If Len(Dieukhien.Text) > Val(sMaxLength) Then 'Kiểm tra xem số ký nhập vào điều khiển đã lớn hơn số ký tự cho 'phép hay chưa Beep nKeyAscii = 0 MsgBox "Số ký tự đã vượt qua giới hạn cho phép", vbInformation, "Thông báo" 'Tắt phím nhập Exit Sub End If sKey = UCase(Chr$(nKeyAscii)) 'đổi mã Ascii sang kiểu ký tự và đỏi ký tự đó ra chữ hoa đồng thời gán cho biến sKey Select Case Left$(Dieukhien.Tag, 1) 'Kiểm tra ký tự đầu tiên của thuộc tính Tag của điều khiển Case "A" 'Tức là điều khiển đó chỉ cho phép nhập ký tự If (Asc(sKey) 32) Or Asc(sKey) > 90 Then 'Kiểm tra nếu mã Ascii của phím nhập mà không 'phải là mã của ký tự thì tắt phím nhập và thoát khỏi thủ tục Beep nKeyAscii = 0 'Tắt phím nhập MsgBox "Bạn không thể nhập số vào đây", vbInformation, "Chú ý" Exit Sub End If Case "N" 'Tức là điểu khiển đó chỉ cho phép nhập phím số If (Asc(Chr$(nKeyAscii)) 46) Or Asc(Chr$(nKeyAscii)) > 57 Then 'Kiểm tra xem phím nhâp có mã Ascii thuộc kiểu số hay không Beep nKeyAscii = 0 'Tắt phím nhập MsgBox "Bạn không thể nhập ký tự vào đây", vbInformation, "Chú ý" Exit Sub End If Case "*" End Select 'Chú ý thuộc tính Tag của điều khiển qui định kiểu dữ liệu có thể nhập vào 'điều khiển đó vd:A11 ,điều khiển đó chỉ cho phép kiểu ký tự và tối đa là 11 ký tự 'N4:điều khiển đó chỉ cho phép cho phép nhập kiểu số với tối đa 4 sô End Sub Public Sub Vohieuhoa(ByVal FrmCTD As Form) Dim Dieukhien As Control For Each Dieukhien In FrmCTD.Controls If (TypeOf Dieukhien Is TextBox) Or (TypeOf Dieukhien Is ComboBox) Or (TypeOf Dieukhien Is RichTextBox) Or (TypeOf Dieukhien Is MaskEdBox) Or (TypeOf Dieukhien Is DBCombo) Or (TypeOf Dieukhien Is DTPicker) Or (TypeOf Dieukhien Is CheckBox) Then Dieukhien.Enabled = False ElseIf TypeOf Dieukhien Is CommandButton Then Select Case Dieukhien.Name Case "cmdThem" Dieukhien.Enabled = True Case "cmdXoa" Dieukhien.Enabled = True Case "cmdLuu" Dieukhien.Enabled = False Case "cmdLocnhanh" Dieukhien.Enabled = True Case "cmdHDThemCTHD" Dieukhien.Enabled = True Case Else Dieukhien.Enabled = False End Select Else 'Dieukhien.Enabled = True End If Next End Sub Public Sub KhoitaoControlsLucThem(ByVal FrmCTD As Form) ', ByVal DataKetnoi As Data) Dim Dieukhien As Control 'DataKetnoi.Enabled = False For Each Dieukhien In FrmCTD.Controls If TypeOf Dieukhien Is CommandButton Then Select Case Dieukhien.Name Case "cmdThem" Dieukhien.Enabled = False Case "cmdXoa" Dieukhien.Enabled = False Case "cmdLuu" Dieukhien.Enabled = True Case "cmdLocnhanh" Dieukhien.Enabled = True Case Else Dieukhien.Enabled = True End Select End If If (TypeOf Dieukhien Is TextBox) Or (TypeOf Dieukhien Is ComboBox) Or (TypeOf Dieukhien Is RichTextBox) Or (TypeOf Dieukhien Is MaskEdBox) Or (TypeOf Dieukhien Is DBCombo) Then Dieukhien.Enabled = True Dieukhien.Text = "" ElseIf TypeOf Dieukhien Is DTPicker Then Dieukhien.Enabled = True Dieukhien.Value = Now() ElseIf (TypeOf Dieukhien Is CheckBox) Then Dieukhien.Enabled = True Dieukhien.Value = 0 Else End If Next End Sub Public Sub Xoa(ByVal DataKetnoi As Data) 'On Error GoTo loi If MsgBox("Bạn có muốn xoá bản ghi này hay không?", vbYesNo, "Thông báo") = vbYes Then DataKetnoi.Recordset.Delete DataKetnoi.Refresh 'DataKetnoi.Recordset.MoveLast Else Exit Sub End If 'loi: ' MsgBox "Không có dữ liệu để xoá", vbInformation, "Thông báo" ' Exit Sub End Sub Public Sub KhoitaoControlsLucLuu(ByVal FrmCTD As Form) ', ByVal DataKetnoi As Data) Dim Dieukhien As Control 'DataKetnoi.Enabled = True For Each Dieukhien In FrmCTD.Controls If TypeOf Dieukhien Is CommandButton Then Select Case Dieukhien.Name Case "cmdThem" Dieukhien.Enabled = True Case "cmdXoa" Dieukhien.Enabled = True Case "cmdLuu" Dieukhien.Enabled = False Case "cmdLocnhanh" Dieukhien.Enabled = True Case Else Dieukhien.Enabled = False End Select End If Next End Sub Public Sub VaoO(ByVal Luoi As VSFlexGrid, ByVal Nhan As Label) With Luoi .Cell(flexcpFontBold, 0, .ColSel) = True .Cell(flexcpForeColor, 0, .ColSel) = &H80& .Cell(flexcpFontBold, .RowSel, .ColSel) = True Nhan.Caption = "(" & .RowSel & "," & .ColSel & ")" End With End Sub Public Sub RoikhoiO(ByVal Luoi As VSFlexGrid) With Luoi .Cell(flexcpFontBold, 0, .ColSel) = False .Cell(flexcpForeColor, 0, .ColSel) = vbBlack .Cell(flexcpFontBold, .RowSel, .ColSel) = False End With End Sub Public Sub SaukhiSua(ByVal Luoi As VSFlexGrid, ByVal Gui As String) On Error GoTo loi With Luoi If (.Col 0) And (.Cell(flexcpText, .RowSel, .ColSel) Gui) Then If MsgBox("Bạn có muốn lưu ô này vào trong CSDL hay klhông?", vbYesNo, "Thông báo") = vbNo Then .Cell(flexcpText, .RowSel, .ColSel) = Gui Exit Sub Else .Cell(flexcpForeColor, .RowSel, .ColSel) = vbRed End If Else End If End With loi: If Luoi.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" Luoi.Cell(flexcpForeColor, Luoi.RowSel, Luoi.ColSel) = vbBlack Exit Sub End If End Sub Public Sub Truockhisua(ByVal Luoi As VSFlexGrid, ByVal GuiDL As String) With Luoi GuiDL = .Cell(flexcpText, .RowSel, .ColSel) End With End Sub Public Sub HienToolTipText(ByVal Luoi As VSFlexGrid) On Error GoTo loi With Luoi .ToolTipText = "Ô có giá trị là: " & .Cell(flexcpText, .MouseRow, .MouseCol) End With loi: Exit Sub End Sub Public Sub Ketnoi(ByVal DataKetnoi As Data, ByVal SQL As String) With DataKetnoi .DatabaseName = "C:\QLKH\CSDL\CsdlQLKH.mdb" .RecordSource = SQL .Refresh End With End Sub Public Sub HienForm(ByVal frm As Form) With frm .Top = (Screen.Height - frm.Height) / 2 .Left = (Screen.Width - frm.Width) / 2 End With End Sub Public Sub CauhinhLuoiChinh(ByVal Luoi As VSFlexGrid) With Luoi .Editable = flexEDKbd .DataMode = flexDMBound .ExplorerBar = flexExSort .AutoResize = True .AutoSearch = flexSearchFromCursor .SelectionMode = flexSelectionFree End With End Sub Public Sub CauhinhLuoiPhu(ByVal Luoi As VSFlexGrid) With Luoi .Editable = flexEDNone .DataMode = flexDMBound .ExplorerBar = flexExSort .AutoResize = True .AutoSearch = flexSearchFromCursor .SelectionMode = flexSelectionFree End With End Sub Public Function ThanhTien(ByVal Soluong As Integer, ByVal Dongia As Currency) As Currency ThanhTien = Soluong * Dongia End Function Public Function TienSauTrietKhau(ByVal Soluong As Integer, ByVal Dongia As Currency, ByVal Trietkhau As Double) As Currency TienSauTrietKhau = Soluong * Dongia * (1 - Trietkhau) End Function 'Hàm này tính tiền thực lãnh sau khi đã nộp thuế VAT Public Function ThucLanh(ByVal Soluong As Integer, ByVal Dongia As Currency, ByVal Trietkhau As Double) As Currency 'Thực lãnh sau khi đã trừ đi thuế VAT ThucLanh = Soluong * Dongia * (1 - Trietkhau) * 0.9 End Function 'Tạo đối tượng ADODB để tiếp cận dữ liệu Public Sub KhoitaoADODB(ByVal SQL As String) On Error GoTo loi 'Thực sự tạo biến đối tượng tiếp cận dữ liệu,đối tượng này dùng 'để kết nối với một CSDL. Set cnado = New ADODB.Connection With cnado 'Chỉ ra trình cung cấp dữ liệu cho đối tượng .Provider = "Microsoft.Jet.OLEDB.3.51" .ConnectionString = "C:\QLKH\CSDL\CsdlQLKH.mdb" .Open End With 'Thực sự tạo ra một đối tượng Recordet. Set rsado = New ADODB.Recordset With rsado .CursorType = adOpenKeyset .LockType = adLockOptimistic 'Chỉ ra nguồn dữ liệu là một Recorset:Bảng,Câu lệnh SQL .Source = SQL 'Kích hoạt kết nối,tức khi đã có đối tượng kết nối và đối tượng 'Recordset nhưng vì đối tượng Recordset là một đối tượng 'không phải là đối tượng con của Connection trong cây phân 'cấp ADODB nên ta muốn nhận được một đối tượng Recordset 'Thực sự thì cần câu lệnh này. .ActiveConnection = cnado .Open End With loi: End Sub 'Thủ tục này định nghĩa các Controls nào được phép để trống Public Sub BuocphaidienDL(ByVal Dieukhien As Control, ByVal PhaidienDL As Boolean) If PhaidienDL = True Then If Dieukhien.Text = "" Then Dieukhien.SetFocus MsgBox "Bạn phải điền dữ liệu vào đây", vbInformation, "Thông báo" Else End If Else End If End Sub Public Sub ThaydoiDD(ByVal SQL As String) 'Thủ tục này định nghĩa đối tượng tiếp cận dữ liêu,đồng thời 'cho phép thay đổi đường dẫn CSDL On Error GoTo loi Set cnado = New ADODB.Connection With cnado .Provider = "Mirosoft.Jet.OLEDB.3.51" .ConnectionString = "C:\QLKH\CSDL\CsdlQLKH.mdb" .Open End With With rsado .LockType = adLockPessimistic .CursorType = adOpenKeyset .Source = SQL .ActiveConnection = cnado .Open End With loi: If Error = 80004005 Then If MsgBox("ứng dụng không kết nối được với CSDL,đường dẫn có thể bị thay đổi.Bạn có muốn tìm đường dẫn hay không?", vbYesNo, "Thông báo") = vbYes Then Dim cdHopthoai As CommonDialog Dim Gan As String Dim Doc As String With cdHopthoai .CancelError = True .DialogTitle = "Chọn đường dẫn đến CSDL" .Filter = "Microsoft Acess Files(*.mdb)|*.mdb" .Filter = 1 .MaxFileSize = 200 .InitDir = "C:\QLKH\CSDL" .ShowOpen Gan = cdHopthoai.FileName End With Dim fso As New FileSystemObject Dim fil As File Dim ts As TextStream Set fso = CreateObject("Scripting.FileSystemObject") fso.CreateTextFile ("C:\QLKH\Duongdan\Path.txt") Set fil = fso.GetFile("C:\QLKH\Duongdan\Path.txt") Set st = fil.OpenAsTextStream(ForWriting) ts.Write (Gan) ts.Close Set ts = fil.OpenAsTextStream(ForReading) Doc = ts.ReadLine ts.Close Set cnado = New ADODB.Connection With cnado .Provider = "Microsoft.Jet.OLEDB.3.51" .ConnectionString = """ & Doc & """ .Open End With rsado .LockType = adLockPessimistic .CursorType = adOpenKeyset .Source = SQL .ActiveConnection = cnado .Open End With Else Exit Sub End If End If End Sub Public Sub BackupDL() 'ByVal LuoiCanBackUp As VSFlexGrid, ByVal TentepTxt As String) Dim cmHopthoai As CommonDialog With cmHopthoai '.CancelError = True '.DialogTitle = "Chọn thư mục cần Backup dữ liệu" '.Filter = "Text Files(*.txt)|*.txt|Microsoft Words(*.doc)|*.doc" '.FilterIndex = 1 '.MaxFileSize = 200 '.InitDir = "C:\QLKH\Backup" .ShowSave End With End Sub Public Sub XoaTatCaDL(ByVal dataNguon As Data) With Data Do While .Recordset.EOF = False .Recordset.Delete .MoveNext Loop .Refresh End With End Sub