Khóa luận Xây dựng phần mềm quản lý nguồn vốn dự án đầu tư tại sở kế hoạch và đầu tư tỉnh Điện Biên

nu).Count - 1 Unload Frm.Controls(mMenu)(i) Next rs.Open "select * from Td_Tree_1 where Congviec='BaoCao' order by TenCay", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load Frm.Controls(mMenu)(Index) End If With Frm.Controls(mMenu)(Index) If i < 10 Then .Caption = "&" & i & ". " & rs.Fields("TenCay").Value Else .Caption = "&" & Chr(55 + i) & ". " & rs.Fields("TenCay").Value End If .Tag = rs.Fields("ID").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next End If rs.Close End Sub Public Sub LoadMenuBaoCaoDong_DM(Frm As Form, mMenu As String, Tudien) Dim i As Long Dim Index As Long Dim rs As New ADODB.Recordset For i = 1 To Frm.Controls(mMenu).Count - 1 Unload Frm.Controls(mMenu)(i) Next rs.Open "select * from Td_DanhMuc where BangTuDien'" & Tudien & "' and tree=1 and BangTuDien 'TinhTrang' and Bangtudien'NguonVon'", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load Frm.Controls(mMenu)(Index) End If With Frm.Controls(mMenu)(Index) If i < 10 Then .Caption = "&" & i & ". Theo " & rs.Fields("TenTuDien").Value Else .Caption = "&" & Chr(55 + i) & ". Theo " & rs.Fields("TenTuDien").Value End If .Tag = rs.Fields("BangTuDien").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next If Index 0 Then Load Frm.Controls(mMenu)(Index) End If With Frm.Controls(mMenu)(Index) If i < 10 Then .Caption = "&" & i & ". Không phân loại" Else .Caption = "&" & Chr(55 + i) & ". Không phân loại" End If .Tag = "KHONGPHANLOAI" .Visible = True End With End If rs.Close End Sub Public Sub LoadMenuBaoCao_TongHopVon() Dim i As Long Dim Index As Long Dim rs As New ADODB.Recordset For i = 1 To FrTreeData.mnuTongHopVonCon.Count - 1 Unload mnuTongHopVonCon(i) Next rs.Open "select * from Td_Tree_1 where Congviec='BaoCao' order by TenCay", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load mnuTongHopVonCon(Index) End If With mnuTongHopVonCon(Index) If i < 10 Then .Caption = "&" & i & ". " & rs.Fields("TenCay").Value Else .Caption = "&" & Chr(55 + i) & ". " & rs.Fields("TenCay").Value End If .Tag = rs.Fields("ID").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next End If rs.Close End Sub Private Sub Form_Unload(Cancel As Integer) Call XoaBangDuAn If BangTreeDuan "" Then gConn.Execute "if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[" & BangTreeDuan & "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) drop table [dbo].[" & BangTreeDuan & "]" End If SaveSetting "HienThiMenu", App.Path, "HienThiMenu", "Td_DiaPhuong" Dim rs As New ADODB.Recordset gSQL = "Select * From Sysobjects Where Xtype='U' And Name Like '_TMP%' Order by Name" rs.Open gSQL, gConn, adOpenKeyset, adLockReadOnly If rs.RecordCount > 50 Then If FgMsgBox("Có đồng ý xóa các bảng dữ liệu không cần thiết không?" & Chr(13) & " (Nếu đồng ý thì đóng tất các máy trạm khác)", vbYesNo) = vbYes Then rs.Close Call DelTmp End If Else rs.Close end if Call SetFontTitleUnloadForm End End Sub Private Sub mnu_M05_Click() gLoaiBaoCao = "NguonVon" F_BaoCaoM5.Caption = "Tình hình thực hiện vốn theo thời gian" F_BaoCaoM5.Show 1 End Sub Private Sub mnuBaocaoTongHop_Click() frmBaocaoTongHop.Show vbModal, Me End Sub Private Sub mnuBC_DauThau_Click() gLoaiBaoCao = "Dauthau" F_BaoCao.Caption = "Báo cáo theo dõi đấu thầu" F_BaoCao.Show 1 End Sub Private Sub mnuBC_NangLuc_Click() gLoaiBaoCao = "NangLuc" F_BaoCao.Caption = "Theo dõi năng lực tăng thêm" F_BaoCao.Show 1 End Sub Private Sub mnuBC_SuatDauTu_Click() gLoaiBaoCao = "Suatdautu" F_BaoCao.Caption = "Báo cáo theo dõi suất đầu tư" F_BaoCao.Show 1 End Sub Private Sub mnuBC_TheoNganh_Click() gLoaiBaoCao = "THEONGANH" F_BaoCao.Caption = "Tổng hợp theo ngành" F_BaoCao.Show 1 End Sub Private Sub mnuBC_theoNhom_Click() gLoaiBaoCao = "THEONHOM" F_BaoCao.Caption = "Tổng hợp theo nhóm" F_BaoCao.Show 1 End Sub Private Sub mnuBosungvonCon_Click(Index As Integer) gCT_NV = "XD" TreeBaocao_ma = Me.mnuTongHopVonCon(Index).Tag Call KiemTra_TinhTrang(CLng(TreeBaocao_ma)) FrNamBaoCao.Show vbModal, Me End Sub Private Sub mnuCoCauVonCon_Click(Index As Integer) gLoaiBaoCao = "CoCauVon" TreeBaocao_ma = Me.mnuTongHopVonCon(Index).Tag Call KiemTra_TinhTrang(CLng(TreeBaocao_ma)) gLoaiBCPB = "Phanbo" frmLuaChon.Show vbModal, Me End Sub Private Sub mnuDanhMucCon_Click(Index As Integer) gsTableDM = "Td_" & Me.mnuDanhMucCon(Index).Tag gsFieldDM = "Ma" & Me.mnuDanhMucCon(Index).Tag gsFieldNameDM = "Ten" & Me.mnuDanhMucCon(Index).Tag sCaption = Mid(Me.mnuDanhMucCon(Index).Caption, 5) gLoadTD = "0" FrTuDien.Show vbModal End Sub Private Sub mnuDonDepDuLieu_Click() gSQL = "delete from PS_Nguonvon where manguonvon not in ( select manguonvon from Td_Nguonvon)" gConn.Execute gSQL gSQL = "delete from PS_KeHoachVon where manguonvon not in ( select manguonvon from Td_Nguonvon)" gConn.Execute gSQL gSQL = "delete from PS_DuToan where maduan not in ( select maduan from PS_DuAn)" gConn.Execute gSQL gSQL = "delete from PS_ThanhToan where maduan not in ( select maduan from PS_DuAn)" gConn.Execute gSQL gSQL = "delete from PS_ThucHien where maduan not in ( select maduan from PS_DuAn)" gConn.Execute gSQL gSQL = "delete from PS_TinhTrang where maduan not in ( select maduan from PS_DuAn)" gConn.Execute gSQL gSQL = "delete from PS_KeHoachVon where maduan not in ( select maduan from PS_NguonVon)" gConn.Execute gSQL gSQL = "delete from Ps_ThongTinKhac where maduan not in ( select maduan from PS_DuAn)" gConn.Execute gSQL gSQL = "delete from BackUpData " gConn.Execute gsql SgMsgBox "Đã dọn dẹp xong dữ liệu rác", vbOKOnly, "Thông báo" End Sub Private Sub mnuDonVi_Click() FrgTdDonVi.Show 1 End Sub Private Sub mnuDuAnHTCon_Click(Index As Integer) gCT_NV = "HT" TreeBaocao_ma = Me.mnuTongHopVonCon(Index).Tag Call KiemTra_TinhTrang(CLng(TreeBaocao_ma)) FrNamBaoCao.Show vbModal, Me End Sub Private Sub mnuHeThong_KetThuc_Click() Unload Me End End Sub Private Sub mnuKeHoachDAcon_Click(Index As Integer) gCT_NV = "Kehoach" TreeBaocao_ma = Me.mnuTongHopVonCon(Index).Tag FrKeHoachvon.Show vbModal, Me End Sub Private Sub mnuNhapKeHoachVon_Click() frmKeHoachVon.Show 1 End Sub Private Sub mnuPassword_Click() FrgChangePassword.Show 1 End Sub Private Sub mnuTheoDoiTT_Click() gLoaiBaoCao = "TinhTrang" F_BaoCaoM5.Caption = "Báo cáo theo tình trạng dự án" F_BaoCaoM5.Show 1 End Sub Private sub mnuTheoNguonVonCon_Click(Index As Integer) gsBang = "TD_Nguonvon" gsMa = "MaNguonVOn" gsTen = "TenNguonVOn" gBangCaption = "Nguồn vốn" gTenCaption = "Nguồn vốn" gLoaiBaoCao = "NguonVon" TreeBaocao_ma = Me.mnuTheoNguonVonCon(Index).Tag frmTest.Show 1 End Sub Private Sub mnuLogin_Click() FrLoginUser.Show vbModal If gUserID "ADMIN" Then Me.mnuPhanQuyen.Enabled = False Else Me.mnuPhanQuyen.Enabled = True End If End Sub Private Sub mnuPhanQuyen_Click() FrListUsers.Show vbModal End Sub Private Sub mnuTree_Click() FrChiTietTree.Show 1 End Sub Private Sub mnuTrogiup_Click() Dim sHelpFile As String sHelpFile = App.Path & "\Doc\QuanLyVon.chm" If Dir(sHelpFile) = vbNullString Then SgMsgBox "Không tìm thấy tệp hướng dẫn sử dụng", vbOKOnly, "Thông báo" Else Shell App.Path & "\Doc\hh.exe " & sHelpFile, vbMaximizedFocus End If End Sub Private Sub mnuUpdate_Click() Call SgUpdate End Sub Private Sub TaoMenuThamSo_Click(Index As Integer) Dim stam As String Dim stam1 As String 'Tên biến Dim mKieuBien As String 'Kiểu biến Dim Vtri As Integer Dim i As Integer Dim rs As New ADODB.Recordset 'Dim mValue As Variant 'I = InStr(MDIFrMain.Caption, "tháng") Vtri = InStr(Me.TaoMenuThamSo(Index).Caption, ".") stam = Trim(Right(Me.TaoMenuThamSo(Index).Caption, Len(Me.TaoMenuThamSo(Index).Caption) - Vtri)) stam1 = GetTenThamSo(stam) mKieuBien = gStr gBienThamSo = stam1 Select Case UCase(stam1) Case UCase("gDonViTienTe") With frmNhapThamSo rs.Open "select * from TudienThamso where BienThamSo='" & stam1 & "'", gConn, adOpenKeyset, adLockReadOnly If rs.RecordCount > 0 Then .txtDieuKien.Text = IIf(IsNull(rs.Fields("Value")), "VNĐ", rs.Fields("Value").Value) Else .txtDieuKien.Text = "VNĐ" End If rs.Close .Caption = "Thay đổi tham số : gDonViTienTe" .lblNhan = "Đơn vị tiền tệ sử dụng:" .Show 1 End With Case UCase("gDonVi") With frmNhapThamSo rs.Open "select * from TudienThamso where BienThamSo='" & stam1 & "'", gConn, adOpenKeyset, adLockReadOnly If rs.RecordCount > 0 Then .txtDieuKien.Text = IIf(IsNull(rs.Fields("Value")), "Sở Kế hoạch và Đầu tư", rs.Fields("Value").Value) Else .txtDieuKien.Text = "Sở Kế hoạch và Đầu tư" End If rs.Close .Caption = "Thay đổi tham số : gDonVi" .lblNhan = "Tên đơn vị:" .Show 1 End With End Select End Sub Private Sub TgDuAn_DblClick() Dim NguoiSD As String gDuan_Id = IIf(IsNull(Me.TgDuAn.Columns("MaDuAn").Value), "", Me.TgDuAn.Columns("MaDuAn").Value) NguoiSD = Ma_NSD(gDuan_Id) If gUserID = NguoiSD Or FgQuyenUser(NguoiSD) = Q_TOANQUYEN Or Q_CHIDOC Then If gDuan_Id "" Then gLoai_FormDA = "Thongtin" FrDuan.Show 1 Else SgMsgBox "Chưa chọn dự án cần xem thông tin chi tiết" End If Else SgMsgBox "Không có quyền xem dự án" End If End Sub Private Sub TgDuAn_FetchRowStyle(ByVal Split As Integer, Bookmark As Variant, ByVal RowStyle As TrueOleDBGrid70.StyleDisp) Dim rs As ADODB.Recordset Set rs = Me.adoDuan.Recordset.Clone If rs.RecordCount > 1 Then rs.Bookmark = Bookmark End If If rs.Fields("Tinhtrang").Value = "" Or IsNull(rs.Fields("TinhTrang")) Then Else RowStyle = Me.TgDuAn.Styles(rs.Fields("Tinhtrang").Value) End If Set rs = Nothing End Sub Private Sub TgDuAn_FormatText(ByVal ColIndex As Integer, Value As Variant, Bookmark As Variant) Select Case ColIndex Case 3, 4, 5, 6, 7 Value = SetChamPhay(Value, True, True) End Select End Sub Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) Dim NguoiSD As String gDuan_Id = IIf(IsNull(Me.TgDuAn.Columns("MaDuAn").Value), "", Me.TgDuAn.Columns("MaDuAn").Value) NguoiSD = Ma_NSD(gDuan_Id) Select Case Button.Index Case 1 'Thêm mới If FgQuyen(M_DULIEUPS) = Q_CHIDOC Or FgQuyen(M_DULIEUPS) = Q_KHONGTRUYCAP Then SgMsgBox "Không có quyền thêm mới dự án" Else gLoai_FormDA = "Themmoi" FrDuan.Show 1 Me.adoDuan.Refresh If Me.adoDuan.Recordset.RecordCount > 0 Then If gVitribanghi > 0 Then Me.adoDuan.Recordset.Move gVitribanghi - 1 End If End If End If Case 2 'Sửa If gUserID = NguoiSD Or FgQuyenUser(NguoiSD) = Q_TOANQUYEN Then If gDuan_Id "" Then gVitribanghi = Me.adoDuan.Recordset.AbsolutePosition gLoai_FormDA = "Sua" FrDuan.Show 1 Me.adoDuan.Refresh If Me.adoDuan.Recordset.RecordCount > 0 Then Me.adoDuan.Recordset.Move gVitribanghi - 1 End If Else SgMsgBox "Chưa chọn dự án cần sửa" End If Else SgMsgBox "Không có quyền sửa dự án của người khác !" End If Case 3 If gUserID = NguoiSD Or FgQuyenUser(NguoiSD) = Q_TOANQUYEN Then If gDuan_Id "" Then If FgMsgBox("Có thực sự muốn xoá dự án " & IIf(IsNull(Me.TgDuAn.Columns("TenDuAn").Value), "", Me.TgDuAn.Columns("TenDuAn").Value) & " không?", vbNo) = vbYes Then gConn.Execute "delete from PS_DuAn where maduan='" & gDuan_Id & "'" Dim Banghi As Long Banghi = Me.adoDuan.Recordset.AbsolutePosition Me.adoDuan.Recordset.Delete Me.adoDuan.Refresh Me.TgDuAn.Refresh If Banghi <= Me.adoDuan.Recordset.RecordCount Then Me.adoDuan.Recordset.Move Banghi - 1 End If End If Else SgMsgBox "Chưa chọn dự án cần xoá" End If Else SgMsgBox "Không có quyền xoá dự án của người khác !" End If Case 4 If gUserID = NguoiSD Or FgQuyenUser(NguoiSD) = Q_TOANQUYEN Or FgQuyenUser(NguoiSD) = Q_CHIDOC Then If gDuan_Id "" Then gLoai_FormDA = "Thongtin" FrDuan.Show 1 Else SgMsgBox "Chưa chọn dự án cần xem thông tin chi tiết" End If Else SgMsgBox "Không có quyền xem dự án của người khác !" End If Case 5 ' "Tìm kiếm" Case 6 ' "Báo cáo" gReportFileName = "rptTongHopDuAn" sFormular = "" sFormular = sFormular & "Donvi='" & gDonVi & "'" sFormular = sFormular & "~DonViTienTe='" & gDonViTienTe & "'" If Me.cboDonViTheoDoi.Text = "Tất cả" Then gSQL = "select TenDuAn, KhoiCong, KetThuc, TMDT, DuToan from " & gTmp_DuAn Else Dim rs As New ADODB.Recordset rs.Open "select * from Td_DonVi where TenDonVi='" & Me.cboDonViTheoDoi.Text & "'", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then gSQL = "select TenDuAn, KhoiCong, KetThuc, TMDT, DuToan from " & gTmp_DuAn & " where maduan in ( SELECT DISTINCT dbo.Ps_DuAn.MaDuAn FROM dbo.Ps_DuAn INNER JOIN dbo.Td_DonVi ON dbo.Ps_DuAn.MaDonVi = dbo.Td_DonVi.MaDonVi where ps_duan.madonvi='" & rs.Fields("MaDonVi").Value & "' ) " Else gSQL = "select TenDuAn, KhoiCong, KetThuc, TMDT, DuToan from " & gTmp_DuAn End If rs.Close End If 'gSQL = "select TenDuAn, KhoiCong, KetThuc, TMDT, KHVon, DuToan, THVon, TTVon from " & gTmp_DuAn & " order by Khoicong,Ketthuc " Set gRs = gConn.Execute(gSQL) ShowReport gReportFileName, gRs, sFormular Set gRs = Nothing Case 7 Unload Me End End Select End Sub Sub Nodechild(Bang As String, TenTruong As String, id As String) Dim sql As String Dim rs As New ADODB.Recordset Dim rs1 As New ADODB.Recordset Dim StrNode As String rs.Open "select " & TenTruong & " from " & Bang & " where parent='" & id & "'", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then rs.MoveFirst While Not rs.EOF rs1.Open "select " & TenTruong & " from " & Bang & " where parent='" & rs.Fields(0).Value & "'", gConn, adOpenStatic, adLockReadOnly If rs1.RecordCount > 0 Then Call Nodechild(Bang, TenTruong, rs.Fields(0).Value) Else sqlchild = sqlchild & "'" & rs.Fields(0).Value & "'," End If rs.MoveNext rs1.Close Wend Else End If sqlchild = sqlchild & "'" & id & "'," End Sub Sub Node_Click(Node As Node) Dim BangTD As String Dim BangPS As String Dim TruongMa As String Dim TruongTen As String Dim cap As Integer Dim sql As String Dim gRs_DuAn As New ADODB.Recordset Dim Rs_Cap As New ADODB.Recordset Dim sqlDuAn As String Dim nodekey As Node Dim StrNode As String Dim id As String Dim Parent As String Dim Kiemtra As Boolean Kiemtra = True Dim Max As Integer Dim STT As String Dim KeyParent As String cap = 1 Dim KiemtraSTT As Boolean Dim Captree As Integer, SqlTree As String, sqlDA As String KiemtraSTT = False SqlTree = "SELECT max(STT) FROM dbo.Td_Tree_1 INNER JOIN dbo.Td_Tree_N ON dbo.Td_Tree_1.ID = dbo.Td_Tree_N.ID INNER JOIN dbo.Td_DanhMuc ON dbo.Td_Tree_N.BangTuDien = dbo.Td_DanhMuc.BangTuDien WHERE dbo.Td_Tree_1.CongViec = 'Tree' and Td_Tree_N.stt=" & cap & " and Td_Tree_N.Tree=1 and TD_Tree_1.ID=" & Captree Rs_Cap.Open SqlTree, gConn, adOpenStatic, adLockReadOnly Max = IIf(IsNull(Rs_Cap.Fields(0)), 1, Rs_Cap.Fields(0).Value) If Node.Key = "r" Then Lap: KiemtraSTT = False SqlTree = "SELECT dbo.Td_Tree_1.ID, dbo.Td_Tree_1.TenCay, dbo.Td_Tree_N.BangTuDien, dbo.Td_DanhMuc.TenTuDien, dbo.Td_DanhMuc.PhanCap, dbo.Td_DanhMuc.LoaiQuanHe, dbo.Td_Tree_N.Tree, dbo.Td_Tree_N.STT FROM dbo.Td_Tree_1 INNER JOIN dbo.Td_Tree_N ON dbo.Td_Tree_1.ID = dbo.Td_Tree_N.ID INNER JOIN dbo.Td_DanhMuc ON dbo.Td_Tree_N.BangTuDien = dbo.Td_DanhMuc.BangTuDien WHERE dbo.Td_Tree_1.CongViec = 'Tree' and Td_Tree_N.stt=" & cap & " and Td_Tree_N.Tree=1 and TD_Tree_1.ID=" & Captree rstree.Open SqlTree, gConn, adOpenStatic, adLockReadOnly If rstree.RecordCount > 0 Then rstree.MoveFirst cap = rstree.Fields("STT").Value BangTD = "Td_" & rstree.Fields("BangTuDien").Value BangPS = IIf(rstree.Fields("LoaiQuanhe").Value = 0, "Ps_" & rstree.Fields("BangTuDien").Value, "PS_DuAn") TruongMa = "Ma" & rstree.Fields("BangTuDien").Value TruongTen = "Ten" & rstree.Fields("BangTuDien").Value Parent = "0" KeyParent = "" sql = "select * from " & BangTD & " where parent='0' order by STT" RsNode.Open sql, gConn, adOpenStatic, adLockReadOnly If RsNode.RecordCount > 0 Then RsNode.MoveFirst While Not RsNode.EOF ' Kiểm tra xem có tồn tại dự án không sqlchild = "" If Node.Key "r" Then sqlDA = KiemTraNode1(Node, BangTD, TruongMa, RsNode.Fields(TruongMa), BangPS, gCapTree) Else sqlDA = "select * from " & BangPS & "," & BangTD & " where " & BangPS & "." & TruongMa & "=" & BangTD & "." & TruongMa & " and " & BangPS & "." & TruongMa & "='" & RsNode.Fields(TruongMa).Value & "'" End If RsDA.Open sqlDA, gConn, adOpenStatic, adLockReadOnly If RsDA.RecordCount > 0 Then 'Nếu tồn tại thì thêm node Me.TvDuLieu.Nodes.Add Node.Key, tvwChild, "Cap" & cap & "@" & Key & "@" & RsNode.Fields(TruongMa).Value & "@'" & RsNode.Fields("Parent").Value & "'", RsNode.Fields(TruongTen).Value, "Pic" & cap, "Open" Key = Key + 1 End If RsDA.Close RsNode.MoveNext Wend KiemtraSTT = True End If RsNode.Close Node.Expanded = True Else 'Thông tin node cuối cùng If cap > Max Then sqlDA = KiemTraNode1(Node, BangTD, TruongMa, id, BangPS, gCapTree) gSQL_Duan = SQLDA_Last Else cap = cap + 1 rstree.Close GoTo Lap End If 'Kết thúc End If rstree.Close 'Hiển thị danh sách dự án If Node.Key = "r" Then gSQL_Duan = "SELECT PS_DuAn.MaDuAn,TenDuAn, ThoiGianKhoiCong, ThoiGianKetThuc,UserID from PS_Duan" Call DuAn With Me.adoDuan .Password = gPSW .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .RecordSource = "select * from " & gTmp_DuAn .Refresh End With Exit Sub Else StrNode = Node.Key Parent = Mid(StrNode, InStrRev(StrNode, "@") + 1) StrNode = Mid(StrNode, 1, Len(StrNode) - Len(Mid(StrNode, InStrRev(StrNode, "@")))) id = Mid(StrNode, InStrRev(StrNode, "@") + 1) StrNode = Mid(StrNode, 1, Len(StrNode) - Len(Mid(StrNode, InStrRev(StrNode, "@")))) StrNode = Mid(StrNode, 1, Len(StrNode) - Len(Mid(StrNode, InStrRev(StrNode, "@")))) cap = CInt(Mid(StrNode, 4)) If Node.Parent.Key "r" Then StrNode = Node.Parent.Key Else StrNode = Node.Key End If KeyParent = Node.Parent.Key SqlTree = "SELECT dbo.Td_Tree_1.ID, dbo.Td_Tree_1.TenCay, dbo.Td_Tree_N.BangTuDien,dbo.Td_DanhMuc.TenTuDien,dbo.Td_DanhMuc.PhanCap,dbo.Td_DanhMuc.LoaiQuanHe, dbo.Td_Tree_N.Tree, dbo.Td_Tree_N.STT FROM dbo.Td_Tree_1 INNER JOIN dbo.Td_Tree_N ON dbo.Td_Tree_1.ID = dbo.Td_Tree_N.ID INNER JOIN dbo.Td_DanhMuc ON dbo.Td_Tree_N.BangTuDien = dbo.Td_DanhMuc.BangTuDien WHERE dbo.Td_Tree_1.CongViec = 'Tree' and Td_Tree_N.stt=" & cap & " and Td_Tree_N.Tree=1 and TD_Tree_1.ID=" & Captree rstree.Open SqlTree, gConn, adOpenStatic, adLockReadOnly If rstree.RecordCount > 0 Then rstree.MoveFirst cap = rstree.Fields("STT").Value BangTD = "Td_" & rstree.Fields("BangTuDien").Value BangPS = IIf(rstree.Fields("LoaiQuanhe").Value = 0, "Ps_" & rstree.Fields("BangTuDien").Value, "PS_DuAn") TruongMa = "Ma" & rstree.Fields("BangTuDien").Value TruongTen = "Ten" & rstree.Fields("BangTuDien").Value sql = "select * from " & BangTD & " where parent='" & id & "' order by stt" RsNode.Open sql, gConn, adOpenStatic, adLockReadOnly If RsNode.RecordCount > 0 Then RsNode.MoveFirst While Not RsNode.EOF ' Kiểm tra xem có tồn tại dự án không sqlchild = "" sqlDA = KiemTraNode(Node, BangTD, TruongMa, RsNode.Fields(TruongMa), gCapTree) RsDA.Open sqlDA, gConn, adOpenStatic, adLockReadOnly If RsDA.RecordCount > 0 Then 'Nếu tồn tại dự án thì thêm node SQLDA_Last = gSQL_Duan Me.TvDuLieu.Nodes.Add Node.Key, tvwChild, "Cap" & cap & "@" & Key & "@" & RsNode.Fields(TruongMa).Value & "@'" & RsNode.Fields("Parent").Value & "'", RsNode.Fields(TruongTen).Value, "Pic" & cap, "Open" Key = Key + 1 End If RsDA.Close RsNode.MoveNext Wend RsNode.Close rstree.Close Else rstree.Close RsNode.Close cap = cap + 1 GoTo Lap End If Node.Expanded = True End If End If Call DuAn With Me.adoDuan .Password = gPSW .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .RecordSource = "select * from " & gTmp_DuAn .Refresh End With End Sub Sub TaoBangDuAn() 'Tao bang du an Call XoaBangDuAn Dim sql As String 'sql = "CREATE TABLE [dbo].[" & gTmp_DuAn & "] ([MaDuAn] [nvarchar] (15) NULL ,[TenDuAn] [nvarchar] (100) NULL ,[KhoiCong] [datetime] NULL ,[KetThuc] [datetime] NULL , UserID nvarchar (15),[TMDT] [float] NULL ,[KHVon] [float] NULL ,[DuToan] [float] NULL ,[THVon] [float] NULL ,[TTVon] [float] NULL,[TinhTrang] [nvarchar] (50) NULL ) ON [PRIMARY]" sql = "CREATE TABLE [dbo].[" & gTmp_DuAn & "] ([STT] [numeric](18, 0) IDENTITY (1, 1),[MaDuAn] [nvarchar] (15) NULL ,[TenDuAn] [nvarchar] (100) NULL ,[KhoiCong] [nvarchar] (7) NULL ,[KetThuc] [nvarchar] (7) NULL , UserID nvarchar (15),[TMDT] [float] NULL ,[DuToan] [float] NULL ,[TinhTrang] [nvarchar] (50) NULL ) ON [PRIMARY]" gConn.Execute sql End Sub Sub XoaBangDuAn() On Error GoTo thoat Dim sql As String sql = " if exists(select * from sysobjects where id=object_id(N'[dbo].[" & gTmp_DuAn & "]') and objectproperty(id,N'IsUserTable')=1) " sql = sql & vbCrLf & " drop table [dbo].[" & gTmp_DuAn & "]" gConn.Execute sql thoat: End Sub 'Sub DuAn(rs As ADODB.Recordset) Sub DuAn() 'On Error Resume Next gTmp_DuAn = FgBangTam 'Dùng lệnh SQL TaoBangDuAn If gSQL_Duan "" Then gSQL = "Insert Into " & gTmp_DuAn & "(MaDuAn,TenDuAn, KhoiCong, KetThuc,TMDT,UserID) " & gSQL_Duan gConn.Execute gSQL gSQL = "Update " & gTmp_DuAn & " Set " & _ " DuToan= isnull((SELECT sum(SoTien) FROM dbo.Td_DuToan INNER JOIN dbo.Ps_DuToan ON dbo.Td_DuToan.MaDuToan = dbo.Ps_DuToan.MaDuToan WHERE (dbo.Td_DuToan.Parent = '0' and PS_DuToan.MaDuAn= " & gTmp_DuAn & ".MaDuAn)),0)," & _ "Tinhtrang = (SELECT Top 1 MaTinhTrang FROM dbo.Ps_TinhTrang WHERE (Ps_TinhTrang.MaDuAn = " & gTmp_DuAn & ".MaDuAn) ORDER BY NgayBatDau Desc) " gConn.Execute gSQL End If Exit Sub End Sub Function TinhTrangDuAn(MaDA As String) As String Dim rs As New ADODB.Recordset rs.Open "SELECT NgayBatDau, MaTinhTrang FROM dbo.Ps_TinhTrang WHERE (MaDuAn = '" & MaDA & "') AND (NgayBatDau = (SELECT MAX(ngaybatdau) FROM PS_TinhTrang WHERE maduan = '" & MaDA & "'))", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then TinhTrangDuAn = IIf(IsNull(rs.Fields(1)), "", rs.Fields(1).Value) Else TinhTrangDuAn = "" End If End Function Public Sub LoadMenuBaoCao_TinhTrang() Dim i As Long Dim Index As Long Dim rs As New ADODB.Recordset For i = 1 To FrTreeData.mnuTinhTrangCon.Count - 1 Unload mnuTinhTrangCon(i) Next rs.Open "select * from Td_Tree_1 where Congviec='BaoCao' order by TenCay", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load mnuTinhTrangCon(Index) End If With mnuTinhTrangCon(Index) If i < 10 Then .Caption = "&" & i & ". " & rs.Fields("TenCay").Value Else .Caption = "&" & Chr(55 + i) & ". " & rs.Fields("TenCay").Value End If .Tag = rs.Fields("ID").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next End If rs.Close End Sub Public Sub LoadMenuBaoCao_Thuchien() Dim i As Long Dim Index As Long Dim rs As New ADODB.Recordset For i = 1 To FrTreeData.mnuLuyKeThucHienCon.Count - 1 Unload mnuLuyKeThucHienCon(i) Next rs.Open "select * from Td_Tree_1 where Congviec='BaoCao' order by TenCay", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load mnuLuyKeThucHienCon(Index) End If With mnuLuyKeThucHienCon(Index) If i < 10 Then .Caption = "&" & i & ". " & rs.Fields("TenCay").Value Else .Caption = "&" & Chr(55 + i) & ". " & rs.Fields("TenCay").Value End If .Tag = rs.Fields("ID").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next End If rs.Close End Sub Public Sub LoadMenuBaoCao_ThuchienVon() Dim i As Long Dim Index As Long Dim rs As New ADODB.Recordset For i = 1 To FrTreeData.mnuThuchienVonCon.Count - 1 Unload mnuThuchienVonCon(i) Next rs.Open "select * from Td_Tree_1 where Congviec='BaoCao' order by TenCay", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load mnuThuchienVonCon(Index) End If With mnuThuchienVonCon(Index) If i < 10 Then .Caption = "&" & i & ". " & rs.Fields("TenCay").Value Else .Caption = "&" & Chr(55 + i) & ". " & rs.Fields("TenCay").Value End If .Tag = rs.Fields("ID").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next End If rs.Close End Sub Public Sub LoadMenuTH_VonDT() Dim i As Long Dim Index As Long Dim rs As New ADODB.Recordset For i = 1 To FrTreeData.mnuTH_VonDTCon.Count - 1 Unload mnuTH_VonDTCon(i) Next rs.Open "select * from Td_Tree_1 where Congviec='BaoCao' order by TenCay", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load mnuTH_VonDTCon(Index) End If With mnuTH_VonDTCon(Index) If i < 10 Then .Caption = "&" & i & ". " & rs.Fields("TenCay").Value Else .Caption = "&" & Chr(55 + i) & ". " & rs.Fields("TenCay").Value End If .Tag = rs.Fields("ID").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next End If rs.Close End Sub Public Sub LoadMenuKehoachVon_DU() Dim i As Long Dim Index As Long Dim rs As New ADODB.Recordset For i = 1 To FrTreeData.mnuKehoachVonDUCon.Count - 1 Unload mnuKehoachVonDUCon(i) Next rs.Open "select * from Td_Tree_1 where Congviec='BaoCao' order by TenCay", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load mnuKehoachVonDUCon(Index) End If With mnuKehoachVonDUCon(Index) If i < 10 Then .Caption = "&" & i & ". " & rs.Fields("TenCay").Value Else .Caption = "&" & Chr(55 + i) & ". " & rs.Fields("TenCay").Value End If .Tag = rs.Fields("ID").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next End If rs.Close End Sub Public Sub LoadMenuBoSungVon() Dim i As Long Dim Index As Long Dim rs As New ADODB.Recordset For i = 1 To FrTreeData.mnuBosungvonCon.Count - 1 Unload mnuBosungvonCon(i) Next rs.Open "select * from Td_Tree_1 where Congviec='BaoCao' order by TenCay", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load mnuBosungvonCon(Index) End If With mnuBosungvonCon(Index) If i < 10 Then .Caption = "&" & i & ". " & rs.Fields("TenCay").Value Else .Caption = "&" & Chr(55 + i) & ". " & rs.Fields("TenCay").Value End If .Tag = rs.Fields("ID").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next End If rs.Close End Sub Public Sub LoadMenuDAHT() Dim i As Long Dim Index As Long Dim rs As New ADODB.Recordset For i = 1 To FrTreeData.mnuDuAnHTCon.Count - 1 Unload mnuDuAnHTCon(i) Next rs.Open "select * from Td_Tree_1 where Congviec='BaoCao' order by TenCay", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load mnuDuAnHTCon(Index) End If With mnuDuAnHTCon(Index) If i < 10 Then .Caption = "&" & i & ". " & rs.Fields("TenCay").Value Else .Caption = "&" & Chr(55 + i) & ". " & rs.Fields("TenCay").Value End If .Tag = rs.Fields("ID").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next End If rs.Close End Sub Public Sub LoadMenuDA_KeHoach() Dim i As Long Dim Index As Long Dim rs As New ADODB.Recordset For i = 1 To FrTreeData.mnuKeHoachDAcon.Count - 1 Unload mnuKeHoachDAcon(i) Next rs.Open "select * from Td_Tree_1 where Congviec='BaoCao' order by TenCay", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then For i = 1 To rs.RecordCount If Index 0 Then Load mnuKeHoachDAcon(Index) End If With mnuKeHoachDAcon(Index) If i < 10 Then .Caption = "&" & i & ". " & rs.Fields("TenCay").Value Else .Caption = "&" & Chr(55 + i) & ". " & rs.Fields("TenCay").Value End If .Tag = rs.Fields("ID").Value .Visible = True End With Index = Index + 1 rs.MoveNext Next End If rs.Close End Sub Function KiemTraNode2(node1 As Node, Bang As String, Truong As String, Id1 As String, bangps1 As String, Captree As Integer) As String Dim sqlDK As String Dim sqlDL As String Dim sqlDL1 As String Dim SqlFrom As String Dim sqlFrom1 As String Dim sqlDA As String Dim nodekey As Node Dim bangold As String Dim BangPSold As String, StrNode As String, Parent As String Dim CapOld As Integer Dim cap As Integer, id As String, SqlTree As String Dim BangPS As String, BangTD As String, TruongMa As String, TruongTen As String bangold = "" BangPSold = "" CapOld = 0 Set nodekey = node1 sqlDL = " " sqlDK = " " SqlFrom = " from PS_DuAn," sqlDA = "select * " gSQL_Duan = "SELECT distinct Ps_DuAn.MaDuAn,TenDuAn, ThoiGianKhoiCong, ThoiGianKetThuc,UserID " SQLDA_Last = "SELECT distinct ps_DuAn.MaDuAn,TenDuAn, ThoiGianKhoiCong, ThoiGianKetThuc,UserID " While Not nodekey.Key = "r" StrNode = nodekey.Key Parent = Mid(StrNode, InStrRev(StrNode, "@") + 1) StrNode = Mid(StrNode, 1, Len(StrNode) - Len(Mid(StrNode, InStrRev(StrNode, "@")))) id = Mid(StrNode, InStrRev(StrNode, "@") + 1) StrNode = Mid(StrNode, 1, Len(StrNode) - Len(Mid(StrNode, InStrRev(StrNode, "@")))) StrNode = Mid(StrNode, 1, Len(StrNode) - Len(Mid(StrNode, InStrRev(StrNode, "@")))) cap = CInt(Mid(StrNode, 4)) SqlTree = "SELECT dbo.Td_Tree_1.ID, dbo.Td_Tree_1.TenCay, dbo.Td_Tree_N.BangTuDien, dbo.Td_DanhMuc.TenTuDien, dbo.Td_DanhMuc.PhanCap, dbo.Td_DanhMuc.LoaiQuanHe, dbo.Td_Tree_N.Tree, dbo.Td_Tree_N.STT FROM dbo.Td_Tree_1 INNER JOIN dbo.Td_Tree_N ON dbo.Td_Tree_1.ID = dbo.Td_Tree_N.ID INNER JOIN dbo.Td_DanhMuc ON dbo.Td_Tree_N.BangTuDien = dbo.Td_DanhMuc.BangTuDien WHERE dbo.Td_Tree_1.CongViec = 'Tree' and Td_Tree_N.stt=" & cap & " and Td_Tree_N.Tree=1 and TD_Tree_1.ID=" & Captree RsDA.Open SqlTree, gConn, adOpenStatic, adLockReadOnly If RsDA.RecordCount > 0 Then RsDA.MoveFirst cap = RsDA.Fields("STT").Value BangTD = "Td_" & RsDA.Fields("BangTuDien").Value BangPS = IIf(RsDA.Fields("LoaiQuanhe").Value = 0, "Ps_" & RsDA.Fields("BangTuDien").Value, "PS_DuAn") TruongMa = "Ma" & RsDA.Fields("BangTuDien").Value TruongTen = "Ten" & RsDA.Fields("BangTuDien").Value End If RsDA.Close If UCase(BangTD) UCase("Td_TinhTrang") Then If CapOld = cap Then If BangPS BangPSold Then sqlDL = sqlDL & BangPS & "." & TruongMa & "='" & id & "' and " End If Else sqlDL = sqlDL & BangPS & "." & TruongMa & "='" & id & "' and " End If CapOld = cap If BangPS = "PS_DuAn" Then If BangTD bangold Then SqlFrom = SqlFrom & BangTD & "," End If Else If BangTD bangold Then If BangPSold BangPS Then SqlFrom = SqlFrom & BangTD & "," & BangPS & "," Else SqlFrom = SqlFrom & BangTD & "," End If Else If BangPS BangPSold Then SqlFrom = SqlFrom & BangPS & "," End If End If End If BangPSold = BangPS sqlDK = sqlDK & " and " & BangPS & "." & TruongMa & "=" & BangTD & "." & TruongMa Set nodekey = nodekey.Parent bangold = BangTD Else 'Là bảng tình trạng BangTam = FgBangTam gSQL = "SELECT MaDuAn, MAX(NgayBatDau) as NgaybatDau into " & BangTam & " FROM dbo.Ps_TinhTrang where ngaybatdau<=" & Date & " GROUP BY MaDuAn" gConn.Execute gSQL 'gSQL="select PS_DuAn.MaDuAn,TenDuan,ps_duan.NgayQuyetDinh,dbo.Ps_DuAn.ThoiGianKhoiCong, dbo.Ps_DuAn.ThoiGianKetThuc,dbo.Ps_DuAn.Ghichu from dbo.Ps_DuAn INNER JOIN dbo.Ps_TinhTrang ON dbo.Ps_DuAn.MaDuAn = dbo.Ps_TinhTrang.MaDuAn INNER JOIN " & bangtam & " ON dbo.Ps_Tinhtrang.MaDuAn = " & bangtam & ".MaDuAn and dbo.Ps_TinhTrang.Ngaybatdau=" & bangtam & ".Ngaybatdau where year(thoigiankhoicong)<=" & TuNam & " and " & sqlTinhTrang & " and " & SqlBaocao & " group by PS_DuAn.MaDuAn,TenDuan,ps_duan.NgayQuyetDinh,dbo.Ps_DuAn.ThoiGianKhoiCong, dbo.Ps_DuAn.ThoiGianKetThuc,dbo.Ps_DuAn.Ghichu" SqlFrom = SqlFrom & BangTam & "," sqlDK = sqlDK & " and dbo.Ps_Tinhtrang.MaDuAn = " & BangTam & ".MaDuAn and dbo.Ps_TinhTrang.Ngaybatdau=" & BangTam & ".Ngaybatdau" End If Wend gSQL_Duan = gSQL_Duan & Mid(SqlFrom, 1, Len(SqlFrom) - 1) & " where " & Mid(sqlDK, 6) & " and " & Mid(sqlDL, 1, Len(sqlDL) - 4) & " GROUP BY ps_DuAn.MaDuAn,dbo.Ps_DuAn.TenDuAn, dbo.Ps_DuAn.ThoiGianKhoiCong, dbo.Ps_DuAn.ThoiGianKetThuc,Ps_DuAn.UserID " Call Nodechild(Bang, Truong, Id1) sqlchild = Bang & "." & Truong & " in (" & Mid(sqlchild, 1, Len(sqlchild) - 1) & ")" sqlDK = Mid(sqlDK, 6) & " and " & Bang & "." & Truong & "=" & bangps1 & "." & Truong sqlDL1 = Mid(sqlDL, 1, Len(sqlDL) - 4) & " and " & bangps1 & "." & Truong & "='" & Id1 & "'" sqlDL = Mid(sqlDL, 1, Len(sqlDL) - 4) & " and " & sqlchild sqlFrom1 = Mid(SqlFrom, 1, Len(SqlFrom) - 1) SqlFrom = Mid(SqlFrom, 1, Len(SqlFrom) - 1) & "," & Bang 'Thêm bang ps If node1.Key "r" Then StrNode = node1.Key Parent = Mid(StrNode, InStrRev(StrNode, "@") + 1) StrNode = Mid(StrNode, 1, Len(StrNode) - Len(Mid(StrNode, InStrRev(StrNode, "@")))) id = Mid(StrNode, InStrRev(StrNode, "@") + 1) StrNode = Mid(StrNode, 1, Len(StrNode) - Len(Mid(StrNode, InStrRev(StrNode, "@")))) StrNode = Mid(StrNode, 1, Len(StrNode) - Len(Mid(StrNode, InStrRev(StrNode, "@")))) cap = CInt(Mid(StrNode, 4)) + 1 SqlTree = "SELECT dbo.Td_Tree_1.ID, dbo.Td_Tree_1.TenCay, dbo.Td_Tree_N.BangTuDien,dbo.Td_DanhMuc.TenTuDien,dbo.Td_DanhMuc.PhanCap, dbo.Td_DanhMuc.LoaiQuanHe, dbo.Td_Tree_N.Tree, dbo.Td_Tree_N.STT FROM dbo.Td_Tree_1 INNER JOIN dbo.Td_Tree_N ON dbo.Td_Tree_1.ID = dbo.Td_Tree_N.ID INNER JOIN dbo.Td_DanhMuc ON dbo.Td_Tree_N.BangTuDien = dbo.Td_DanhMuc.BangTuDien WHERE dbo.Td_Tree_1.CongViec = 'Tree' and Td_Tree_N.stt=" & cap & " and Td_Tree_N.Tree=1 and TD_Tree_1.ID=" & Captree 'RsDA.Open "select * from Td_Tree where stt=" & cap & " and Tree=1", gConn, adOpenStatic, adLockReadOnly RsDA.Open SqlTree, gConn, adOpenStatic, adLockReadOnly If RsDA.RecordCount > 0 Then RsDA.MoveFirst BangPS = IIf(RsDA.Fields("LoaiQuanhe").Value = 0, "Ps_" & RsDA.Fields("BangTuDien").Value, "PS_DuAn") End If RsDA.Close If BangPS "PS_DuAn" Then SqlFrom = SqlFrom & "," & BangPS sqlFrom1 = sqlFrom1 & "," & BangPS End If End If 'Kết thúc kiểm tra để thêm sqlDA = sqlDA & SqlFrom & " where " & sqlDK & " and " & sqlDL SQLDA_Last = SQLDA_Last & sqlFrom1 & " where " & sqlDK & " and " & sqlDL1 KiemTraNode2 = sqlDA End Function Sub gTonghopTreeDuAn(BangTree As String) Dim rstree As New ADODB.Recordset, RsAdd As New ADODB.Recordset, RsTinhToan As New ADODB.Recordset Dim rsDuan As New ADODB.Recordset 'Tạo bảng dữ liệu If BangTreeDuan "" Then gConn.Execute "if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[" & BangTreeDuan & "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) drop table [dbo].[" & BangTreeDuan & "]" End If BangTreeDuan = FgBangTam gSQL = "CREATE TABLE [dbo].[" & BangTreeDuan & "] ([Ma] [nvarchar] (4000),[Ten] [nvarchar] (1000),[Parent] [nvarchar] (4000),[SapXep] [nvarchar] (80),[CacDA] [nvarchar] (4000),[Cap] [numeric](4, 0))" gConn.Execute gSQL RsAdd.Open BangTreeDuan, gConn, adOpenKeyset, adLockOptimistic BangTam_TinhTrang = FgBangTam gSQL = "SELECT MaDuAn, MAX(NgayBatDau) as NgaybatDau into " & BangTam_TinhTrang & " FROM dbo.Ps_TinhTrang GROUP BY MaDuAn" gConn.Execute gSQL rstree.Open "select Ma, Ten, Parent,Sapxep,cap from " & BangTree & " order by sapxep" & gCOLLATE, gConn, adOpenStatic, adLockReadOnly Dim CacDA As String If rstree.RecordCount > 0 Then rstree.MoveFirst While Not rstree.EOF SqlBaocao = "" CacDA = "" KiemTraTinhTrang = False Call SqlTree1(rstree.Fields("Ma").Value, rstree.Fields("Parent").Value) If KiemTraTinhTrang = False Then gSQL = "select DISTINCT PS_DuAn.MaDuAn FROM dbo.Ps_DuAn Left JOIN dbo.Ps_NguonVon ON dbo.Ps_DuAn.MaDuAn = dbo.Ps_NguonVon.MaDuAn WHERE " & SqlBaocao & " " Else gSQL = "select DISTINCT PS_DuAn.MaDuAn FROM dbo.Ps_DuAn Left JOIN dbo.Ps_NguonVon ON dbo.Ps_DuAn.MaDuAn = dbo.Ps_NguonVon.MaDuAn INNER JOIN dbo.Ps_TinhTrang ON dbo.Ps_DuAn.MaDuAn = dbo.Ps_TinhTrang.MaDuAn INNER JOIN " & BangTam_TinhTrang & " ON dbo.Ps_Tinhtrang.MaDuAn = " & BangTam_TinhTrang & ".MaDuAn and dbo.Ps_TinhTrang.Ngaybatdau=" & BangTam_TinhTrang & ".Ngaybatdau WHERE " & SqlBaocao & " " End If rsDuan.Open gSQL, gConn, adOpenStatic, adLockReadOnly If rsDuan.RecordCount > 0 Then rsDuan.MoveFirst While Not rsDuan.EOF CacDA = CacDA & "'" & rsDuan.Fields("Maduan").Value & "'," rsDuan.MoveNext Wend CacDA = Mid(CacDA, 1, Len(CacDA) - 1) 'Tiến hành thêm vào cơ sở dữ liệu With RsAdd .AddNew .Fields("Ma").Value = rstree.Fields("Ma").Value .Fields("Ten").Value = rstree.Fields("Ten").Value .Fields("Parent").Value = rstree.Fields("Parent").Value .Fields("Sapxep").Value = rstree.Fields("Sapxep").Value .Fields("CacDA").Value = CacDA .Fields("Cap").Value = rstree.Fields("Cap").Value .Update End With End If rsDuan.Close rstree.MoveNext Wend End If rstree.Close RsAdd.Close gConn.Execute "drop table " & BangTree gConn.Execute "drop table " & BangTam_TinhTrang End Sub Public Sub SqlTree1(id As String, Parent As String) Dim Con As String, Cha As String, str As String, str1 As String, str2 As String Dim TenTruong As String, Ma As String str = id If InStrRev(str, "@") = 0 Then Ma = Mid(str, InStrRev(str, "_") + 1) TenTruong = Mid(str, 1, Len(str) - Len(Ma) - 1) Call SqlChildStr("Td_" & TenTruong, "Ma" & TenTruong, Ma) SqlBaocao = SqlBaocao & Mid(sqlchild, 1, Len(sqlchild) - 1) & ")" If UCase(TenTruong) = UCase("Tinhtrang") Then KiemTraTinhTrang = True End If Else If InStrRev(str, "@") 0 Then str1 = Mid(str, 1, Len(str) - Len(Mid(str, InStrRev(str, "@")))) str2 = Mid(str, InStrRev(str, "@") + 1) If str2 = "" Then str2 = str1 str = Mid(str, 1, Len(str) - 1) Else str = Mid(str, 1, Len(str) - Len(Mid(str, InStrRev(str, "@")))) End If Ma = Mid(str2, InStrRev(str2, "_") + 1) TenTruong = Mid(str2, 1, Len(str2) - Len(Ma) - 1) If UCase(TenTruong) = UCase("Tinhtrang") Then KiemTraTinhTrang = True End If Call SqlChildStr("Td_" & TenTruong, "Ma" & TenTruong, Ma) SqlBaocao = SqlBaocao & Mid(sqlchild, 1, Len(sqlchild) - 1) & ")" & " and " Call SqlTree(str, str) End If End If End Sub Sub gLenTreeCacDuAn(Bang As String) On Error Resume Next gSQL = "Select * from " & Bang & " Order by SapXep " & gCOLLATE Dim rsSTT As New ADODB.Recordset rsSTT.Open gSQL, gConn, adOpenKeyset, adLockOptimistic TvDuLieu.Nodes.Clear TvDuLieu.Nodes.Add , , "r", "Danh mục các dự án ", "Root" TvDuLieu.Nodes(1).Expanded = True If rsSTT.RecordCount > 0 Then Do While Not rsSTT.EOF If Right(rsSTT.Fields("Parent"), 1) "0" Then TvDuLieu.Nodes.Add "a" & rsSTT.Fields("Parent"), tvwChild, "a" & rsSTT.Fields("Ma"), rsSTT.Fields("Ten"), 1, 3 Else TvDuLieu.Nodes.Add "r", tvwChild, "a" & rsSTT.Fields("Ma"), rsSTT.Fields("Ten"), "Pic" & IIf(IsNull(rsSTT.Fields("Cap")), 1, rsSTT.Fields("Cap").Value), "Open" End If rsSTT.MoveNext Loop End If End Sub Sub LoadDulieuDuAn(Tree As String) tmp_treeTT = FgTongHopCay(CDbl(Tree), "Tree") Call gTonghopTreeDuAn(tmp_treeTT) Call gLenTreeCacDuAn(BangTreeDuan) End Sub Sub NodeClickTonghop(Node As Node) Dim rsTong As New ADODB.Recordset, rs As New ADODB.Recordset If Node.Key = "r" Then gSQL_Duan = "SELECT distinct PS_DuAn.MaDuAn,TenDuAn, ThoiGianKhoiCong, ThoiGianKetThuc,TongMucDauTu,UserID from PS_Duan" Else rs.Open "select * from " & BangTreeDuan & " where ma='" & Mid(Node.Key, 2) & "'", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then If rs.Fields("CacDA").Value "" Then gSQL_Duan = "SELECT distinct PS_DuAn.MaDuAn,TenDuAn, ThoiGianKhoiCong, ThoiGianKetThuc,TongMucDauTu,UserID from PS_Duan where maduan in (" & rs.Fields("CacDA").Value & ")" Else gSQL_Duan = "" End If End If End If Call DuAn With Me.adoDuan .Password = gPSW .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .RecordSource = "select * from " & gTmp_DuAn .Refresh End With rsTong.Open "select sum(TMDT),sum(DuToan) from " & gTmp_DuAn, gConn, adOpenStatic, adLockReadOnly Me.TgDuAn.Columns("TMDT").FooterText = SetChamPhay(IIf(rsTong.Fields(0).Value "", rsTong.Fields(0).Value, 0), True, True) Me.TgDuAn.Columns("DuToan").FooterText = SetChamPhay(IIf(rsTong.Fields(1).Value "", rsTong.Fields(1).Value, 0), True, True) rsTong.Close End Sub Sub NodeClick_ChiTiet(Bang As String, Node As Node) 'On Error GoTo thoat Dim BangTam As String Dim sql As String Dim gRs_DuAn As New ADODB.Recordset Dim rs As New ADODB.Recordset Dim RsPS As New ADODB.Recordset Dim BangPS As String Dim sqlJoin As String If Bang "Td_TinhTrang" Then If Node.Key = "r" Then sql = "Select * from " & Bang & " where parent= '0'" gSQL_Duan = "SELECT distinct PS_DuAn.MaDuAn,TenDuAn, KhoiCong, KetThuc,TongMucDauTu,UserID from PS_Duan" Else sql = "Select * from " & Bang & " where parent= '" & Right(Node.Key, Len(Node.Key) - 1) & "'" sqlchild = "" Call Nodechild(Bang, "Ma" & Mid(Bang, 4), Mid(Node.Key, 2)) sqlchild = Mid(sqlchild, 1, Len(sqlchild) - 1) RsPS.Open "select LoaiQuanHe from TD_DanhMuc where BangTuDien='" & Mid(Bang, 4) & "'", gConn, adOpenStatic, adLockReadOnly If RsPS.RecordCount > 0 Then If RsPS.Fields(0).Value = 0 Then BangPS = "PS_" & Mid(Bang, 4) sqlJoin = "PS_DuAn.MaDuAn=" & BangPS & ".MaDuAn and " & BangPS & ".Ma" & Mid(Bang, 4) & "=" & Bang & ".Ma" & Mid(Bang, 4) gSQL_Duan = "SELECT distinct PS_DuAn.MaDuAn,TenDuAn, KhoiCong, KetThuc,TongMucDauTu,UserID from PS_DuAn," & BangPS & "," & Bang & " where " & sqlJoin & " and " & BangPS & ".Ma" & Mid(Bang, 4) & " in (" & sqlchild & ") " Else gSQL_Duan = "SELECT distinct PS_DuAn.MaDuAn,TenDuAn, KhoiCong, KetThuc,TongMucDauTu,UserID from PS_DuAn," & Bang & " where PS_Duan.Ma" & Mid(Bang, 4) & "=" & Bang & ".Ma" & Mid(Bang, 4) & " and PS_DuAn.Ma" & Mid(Bang, 4) & " in (" & sqlchild & ") " End if Else gSQL_Duan = "SELECT distinct PS_DuAn.MaDuAn,TenDuAn, KhoiCong, KetThuc,TongMucDauTu,UserID from PS_Duan" End If End If Node.Expanded = True Else 'Là theo tình trạng If Node.Key = "r" Then sql = "Select * from " & Bang & " where parent= '0'" gSQL_Duan = "SELECT distinct PS_DuAn.MaDuAn,TenDuAn, KhoiCong, KetThuc,TongMucDauTu,UserID from PS_Duan" Else sql = "Select * from " & Bang & " where parent= '" & Right(Node.Key, Len(Node.Key) - 1) & "'" sqlchild = "" Call Nodechild(Bang, "Ma" & Mid(Bang, 4), Mid(Node.Key, 2)) sqlchild = Mid(sqlchild, 1, Len(sqlchild) - 1) RsPS.Open "select LoaiQuanHe from TD_DanhMuc where BangTuDien='" & Mid(Bang, 4) & "'", gConn, adOpenStatic, adLockReadOnly BangTam = FgBangTam gSQL = "SELECT MaDuAn, MAX(NgayBatDau) as NgaybatDau into " & BangTam & " FROM dbo.Ps_TinhTrang GROUP BY MaDuAn" gConn.Execute gSQL BangPS = "PS_" & Mid(Bang, 4) gSQL_Duan = "SELECT distinct PS_DuAn.MaDuAn,TenDuAn,KhoiCong, KetThuc,TongMucDauTu,UserID from dbo.Ps_DuAn INNER JOIN dbo.Ps_TinhTrang ON dbo.Ps_DuAn.MaDuAn = dbo.Ps_TinhTrang.MaDuAn INNER JOIN " & BangTam & " ON dbo.Ps_Tinhtrang.MaDuAn = " & BangTam & ".MaDuAn and dbo.Ps_TinhTrang.Ngaybatdau=" & BangTam & ".Ngaybatdau where " & BangPS & ".Ma" & Mid(Bang, 4) & " in (" & sqlchild & ") " End If Node.Expanded = True End If Call DuAn With Me.adoDuan .Password = gPSW .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .RecordSource = "select * from " & gTmp_DuAn .Refresh End With Dim rsTong As New ADODB.Recordset rsTong.Open "select sum(TMDT),sum(DuToan) from " & gTmp_DuAn, gConn, adOpenStatic, adLockReadOnly Me.TgDuAn.Columns("TMDT").FooterText = SetChamPhay(IIf(rsTong.Fields(0).Value "", rsTong.Fields(0).Value, 0), True, True) Me.TgDuAn.Columns("DuToan").FooterText = SetChamPhay(IIf(rsTong.Fields(1).Value "", rsTong.Fields(1).Value, 0), True, True) rsTong.Close If BangTam "" Then sql = " if exists(select * from sysobjects where id=object_id(N'[dbo].[" & BangTam & "]') and objectproperty(id,N'IsUserTable')=1) " sql = sql & vbCrLf & " drop table [dbo].[" & BangTam & "]" gConn.Execute sql End If End Sub Sub gLenTreeCacDuAn1(Bang As String, Truong As String) gSQL = "Select * from " & Bang & " Order by SapXep " & gCOLLATE Dim rsSTT As New ADODB.Recordset rsSTT.Open gSQL, gConn, adOpenKeyset, adLockOptimistic TvDuLieu.Nodes.Clear TvDuLieu.Nodes.Add , , "r", "Danh mục các dự án ", "Root" TvDuLieu.Nodes(1).Expanded = True If rsSTT.RecordCount > 0 Then Do While Not rsSTT.EOF If Right(rsSTT.Fields("Parent"), 1) "0" Then TvDuLieu.Nodes.Add "a" & rsSTT.Fields("Parent"), tvwChild, "a" & rsSTT.Fields("Ma" & Truong), rsSTT.Fields("Ten" & Truong), 1, 3 Else TvDuLieu.Nodes.Add "r", tvwChild, "a" & rsSTT.Fields("Ma" & Truong), rsSTT.Fields("Ten" & Truong), "Pic" & IIf(IsNull(rsSTT.Fields("Cap")), 1, rsSTT.Fields("Cap").Value), "Open" End If rsSTT.MoveNext Loop End If End Sub Sub TatCaCacDuAn() On Error Resume Next gSQL_Duan = "SELECT distinct PS_DuAn.MaDuAn,TenDuAn, KhoiCong, KetThuc,TongMucDauTu,UserID from PS_Duan" Call DuAn With Me.adoDuan .Password = gPSW .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .RecordSource = "select * from " & gTmp_DuAn & " order by Khoicong,Ketthuc " .Refresh End With Dim rsTong As New ADODB.Recordset rsTong.Open "select sum(TMDT),sum(DuToan) from " & gTmp_DuAn, gConn, adOpenStatic, adLockReadOnly Me.TgDuAn.Columns("TMDT").FooterText = SetChamPhay(IIf(rsTong.Fields(0).Value "", rsTong.Fields(0).Value, 0), True, True) Me.TgDuAn.Columns("DuToan").FooterText = SetChamPhay(IIf(rsTong.Fields(1).Value "", rsTong.Fields(1).Value, 0), True, True) rsTong.Close End Sub Private Function AddDonViQuanLy() On Error GoTo thoat cboDonViTheoDoi.Clear cboDonViTheoDoi.AddItem "Tất cả" Dim rs As New ADODB.Recordset rs.Open "SELECT * FROM Td_DonVi ", gConn, adOpenStatic, adLockOptimistic, adCmdText If rs.RecordCount = 0 Then cboDonViTheoDoi.Text = "Tất cả" Else Do While Not rs.EOF = True cboDonViTheoDoi.AddItem rs!TenDonVi & "" rs.MoveNext Loop cboDonViTheoDoi.Text = "Tất cả" End If Set rs = Nothing thoat: End Function Code Form ThemMoiDuAn Option Explicit Dim tmp_PsVon As String Dim tmp_KhVon As String, tmp_KhVon1 As String Dim tmp_Congsuat As String Dim tmp_PsDauThau As String Dim tmp_NhaThau As String, tmp_NhaThau1 As String Dim tmp_DuToan As String Dim tmp_ThucHien As String Dim tmp_ThanhToan As String Dim tmp_Tinhtrang As String Dim tmp_ThongtinKhac As String Dim loi As String Dim Dongform As Boolean Dim T_Style() As Style Dim TenQD As String Dim LanThayDoi As Integer Dim rsUpdate As New ADODB.Recordset Dim KiemtraTonTai As Boolean Private Sub cmChapnhan_Click() Dim rs As New ADODB.Recordset, rs1 As New ADODB.Recordset, TongMucDT As Double Screen.MousePointer = 11 Select Case gLoai_FormDA Case "Themmoi" If Me.txTenDuAn.Text "" Then rs.Open "select * from " & tmp_PsVon, gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then rs1.Open "select sum(isnull(TienTrongNuoc,0)) from " & tmp_PsVon, gConn, adOpenStatic, adLockReadOnly TongMucDT = IIf(IsNull(rs1.Fields(0)), 0, rs1.Fields(0).Value) If TongMucDT CDbl(Me.txtTongMucDauTu.Text) Then SgMsgBox "Tổng mức đầu tư khác tổng cơ cấu nguồn vốn hình thành" Me.txtTongMucDauTu.SetFocus Screen.MousePointer = 99 Exit Sub End If rs1.Close End If rs.Close On Error GoTo ErrNew Me.TgCongsuat.Update Me.TgDauthau.Update Me.TgDutoan.Update Me.TgKHvon.Update Me.TgNhaThau.Update Me.TgThanhtoan.Update Me.TgThuchien.Update Me.TgTinhtrang.Update Me.TgVon.Update Me.TgThongTinKhac.Update GoTo ContNew ErrNew: SgMsgBox "Có lỗi khi nhập dữ liệu !" Exit Sub ContNew: On Error GoTo 0 Themmoi_DuAn Dongform = True SgMsgBox "Đã lưu dữ liệu." Else SgMsgBox "Chưa nhập tên dự án." Me.txTenDuAn.SetFocus End If Case "Sua" If Me.txTenDuAn.Text "" Then If CDate(Me.MsNgayKC) > CDate(Me.MsNgayKT) Then SgMsgBox "Ngày khởi công lớn hơn ngày kết thúc" Me.MsNgayKC.SetFocus Exit Sub End If rs.Open "select * from " & tmp_PsVon, gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then rs1.Open "select sum(isnull(TienTrongNuoc,0)) from " & tmp_PsVon, gConn, adOpenStatic, adLockReadOnly TongMucDT = IIf(IsNull(rs1.Fields(0)), 0, rs1.Fields(0).Value) If TongMucDT CDbl(Me.txtTongMucDauTu.Text) Then SgMsgBox "Tổng mức đầu tư khác tổng cơ cấu nguồn vốn hình thành" Me.txtTongMucDauTu.SetFocus Screen.MousePointer = 99 Exit Sub End If rs1.Close End If rs.Close On Error GoTo ErrUpdate Me.TgCongsuat.Update Me.TgDauthau.Update Me.TgDutoan.Update Me.TgKHvon.Update Me.TgNhaThau.Update Me.TgThanhtoan.Update Me.TgThuchien.Update Me.TgTinhtrang.Update Me.TgVon.Update GoTo ContUpdate ErrUpdate: SgMsgBox "Có lỗi khi nhập dữ liệu !" Exit Sub ContUpdate: On Error GoTo 0 Capnhat_DuAn (gDuan_Id) Dongform = True SgMsgBox "Đã lưu dữ liệu." Else SgMsgBox "Chưa nhập tên dự án." Me.txTenDuAn.SetFocus End If End Select Screen.MousePointer = 99 End Sub