Với sự đi lên không ngừng của nền kinh tếthì quản lý vốn dựán đầu tư
đang ngày càng trởnên cần thiết và cấp bách hơn bao giờhết. Việc xây dựng
phần mềm sẽlàm cho việc quản lý nguồn vốn quản lý dựán của Sởkếhoạch
và Đầu tưtỉnh Điện Biên dễdàng và thuận tiện hơn. Các thông tin vềvốn của
dựán sẽ được cập nhật nhanh chóng và chính xác tại mọi thời điểm. Chính vì
vậy mà SởKếhoạch và Đầu tưtỉnh Điện Biên là một trong những SởKế
hoạch và Đầu tư đầu tiên trên cảnước đi đầu trong việc tin học quản lý vốn
dựán đầu tư.
173 trang |
Chia sẻ: lylyngoc | Lượt xem: 2364 | Lượt tải: 0
Bạn đang xem trước 20 trang tài liệu Luận vă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, để xem tài liệu hoàn chỉnh bạn click vào nút DOWNLOAD ở trên
aoCao' 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
127
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
128
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"
129
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
130
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
131
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()
132
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
133
.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)
134
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
135
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
136
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
137
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
138
'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
139
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
140
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)
141
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
142
'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
143
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.Pha
nCap,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
144
'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
145
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
146
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)
147
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
148
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)
149
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)
150
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
151
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
152
.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
153
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
154
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, "@"))))
155
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
156
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
157
'gSQL="select
PS_DuAn.MaDuAn,TenDuan,ps_duan.NgayQuyetDinh,dbo.Ps_DuAn.ThoiGianKh
oiCong, 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.ThoiGianKh
oiCong, 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
158
'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.Pha
nCap, 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
159
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"
160
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
161
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
162
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"
163
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
164
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
165
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 & ") "
166
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 & ") "
167
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
168
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 "
169
.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
170
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
171
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
172
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
173
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
Các file đính kèm theo tài liệu này:
- 10341_8936.pdf