LỜI MỞ ĐẦU1
CHƯƠNG I: GIỚI THIỆU CHUNG VỀ CÔNG TY TIN HỌC XÂY DỰNG VÀ BÀI TOÁN 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ÊN4
I. GIỚI THIỆU CHUNG VỀ CÔNG TY TIN HỌC XÂY DỰNG4
1. Quá trình hình thành và phát triển. 4
2. Các loại hàng hoá dịch vụ chủ yếu hiện tại Công ty đang kinh doanh. 6
2.1. Nhóm phần mềm quản lý hoạt động của doanh nghiệp xây dựng. 6
2.2. Nhóm phần mềm kỹ thuật xây dựng. 6
2.3. Nhóm phần mềm thiết kế cơ sở hạ tầng. 7
2.4. Nhóm phần mềm quản lý quy hoạch xây dựng. 7
2.5. Dịch vụ tư vấn thiết kế xây dựng. 7
2.6. Dịch vụ kinh doanh xuất nhập khẩu thiết bị công nghệ thông tin. 7
2.7. Dịch vụ đào tạo, bồi dưỡng công nghệ thông tin, tư vấn thiết kế xây dựng. 7
3. Cơ cấu tổ chức của Công ty. 7
3.1. Ban giám đốc công ty. 8
3.2. Tổ chức hành chính. 9
3.3. Ban khoa học công nghệ. 10
3.4. XN phần mềm quản lý. 10
3.5. XN phần mềm tư vấn xây dựng. 10
3.6. XN Kinh doanh thiết bị tin học. 10
3.7. XN Tự động hóa và tư vấn xây dựng. 11
3.8. Trung tâm đào tạo và chuyển giao công nghệ. 11
3.8.1. Các hình thức đào tạo. 11
3.8.2. Các nội dung đào tạo. 12
3.9. Trung tâm tư vấn thẩm định dự án CNTT. 12
3.10. Trung tâm nghiên cứu và phát triển CNTT. 13
4. Tình hình tin học hoá công tác quản lý của công ty. 13
II. BÁI TOÁN 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ÊN15
1. Khái quát hoạt động tại Sở Kế hoạch và Đầu tư tỉnh Điện Biên. 15
1.1 Chức năng và nhiệm vụ của Sở Kế hoạch và Đầu tư tỉnh Điện Biên. 15
1.2 Cơ cấu tổ chức của Sở Kế hoạch và Đầu tư tỉnh Điện Biên. 17
1.2.1. Sơ đồ cơ cấu tổ chức. 17
1.2.2.Chức năng nhiệm vụ của từng phòng ban. 18
2. Thực trạng ứng dụng công nghệ thông tin tại Sở Kế hoạch và Đầu tư Điện Biên và lý do lựa chọn đề tài26
2.1. Thực trạng tin học hóa quản lý nguồn vốn dự án tại Sở Kế hoạch và Đầu tư tỉnh Điện Biên26
2.2. Lý do lựa chọn đề tài nghiên cứu. 26
3. Chức năng của 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. 27
3.1 Qui trình quản lý nguồn vốn đầu tư bằng phương pháp thủ công. 27
3.2. Chức năng đạt được của phần mềm quản lý nguồn vốn. 27
3.3. Những đối tượng chính được hưởng lợi từ phần mềm quản lý nguồn vốn đầu tư tại Sở Kế hoạch và Đầu tư tỉnh Điện Biên. 28
3.3.1. Sở Kế hoạch và Đầu tư tỉnh Điện Biên. 28
3.3.2. Uỷ ban nhân dân tỉnh Điện Biên. 28
3.3.3. Chủ đầu tư của dự án. 29
3.3.4. Nhân viên văn phòng. 29
3.3.5. Nhân viên kế toán, tài chính. 29
3.4 Phạm vi ứng dụng của đề tài29
CHƯƠNG II: PHƯƠNG PHÁP LUẬN CƠ BẢ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ÊN30
1. Tổng quan về hệ thống thông tin quản lý. 30
1.1 Định nghĩa và các bộ phận cấu thành hệ thống thông tin. 30
1.2 Phân loại các hệ thống thông tin trong tổ chức. 31
1.3 Tầm quan trọng của hệ thống thông tin. 33
2. Phương pháp phát triển một hệ thống thông tin. 34
2.1 Nguyên nhân dẫn đến viêc phát triển một hệ thống thông tin mới34
2.2 Phương pháp phát triển một hệ thống thông tin. 35
3. Phân tích hệ thống thông tin. 35
3.1 Các phương pháp thu thập thông tin. 35
3.2 Mã hóa dữ liệu. 35
3.3 Các công cụ mô hình hóa hệ thống thông tin. 36
4 Quy trình xây dựng phần mềm ứng dụng. 37
4.1 Đánh giá yêu cầu. 37
4.2 Phân tích chi tiết38
4.3 Thiết kế logic. 38
4.4 Đề xuất các phương án của giải pháp. 38
4.5 Thiết kế vật lý ngoài39
4.6 Triển khai kỹ thuật hệ thống. 39
4.7 Cài đặt và khai thác. 39
5. Thiết kế cơ sở dữ liệu. 40
5.1 Thiết kế cơ sở dữ liệu logic đi từ các thông tin ra. 40
5.1.1 Xác định các đầu ra. 40
5.1.2 Xác định các tệp cần thiết cung cấp dữ liệu cho việc tạo ra từng đầu ra. 41
5.2 Thiết kế cơ sở dữ liệu bằng phương pháp mô hình hóa. 48
6. Khái quát về công cụ sử dụng để thực hiện đề tài50
6.1 Hệ quản trị cơ sở dữ liệu SQL Server50
6.2 Ngôn ngữ lập trình Visual Basic 6.0. 51
CHƯƠNG III: PHÂN TÍCH THIẾT KẾ 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ÊN52
1. Khái quát về bài toán quản lý. 52
1.1. Thực tế qui trình 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ên52
1.2. Mục đích cần đạt được của phần mềm53
1.3. Thông tin đầu vào và thông tin đầu ra của phần mềm54
1.3.1. Thông tin đầu vào. 54
1.3.2. Thông tin đầu ra. 56
2. Mô hình hoá hệ thống thông tin quản lý vốn dự án đầu tư. 57
2.1Sơ đồ chức năng BFD của chương trình. 57
2.2. Sơ đồ luồng thông tin. 58
2.3. Sơ đồ ngữ cảnh của Quản lý nguồn vốn dự án dự án đầu tư tại Sở Kế hoạch và Đầu tư tỉnh Điện Biên. 59
2.4. Sơ đồ luồng dữ liệu(DFD) của hệ thống. 59
2.4. Sơ đồ luồng dữ liệu(DFD) của hệ thống. 60
2.4.1. Sơ đồ luồng dữ liệu mức 0 của hệ thống. 60
2.4.2. Sơ đồ phân rã xử lý mức 1. 61
3.Thiết kế cơ sở dữ liệu. 64
3.1 Mô hình quan hệ thực thể ERD65
3.2 Chuyển đổi quan hệ hai chiều trong mô hình thực thể ERD65
3.3 Một số bảng trong cơ sở dữ liệu quản lý nguồn vốn dự án đầu tư. 69
3.4 Mô hình quan hệ giữa các bảng trong cơ sở dữ liệu. 76
4.Thiết kế giải thuật77
4.1. Khái niệm giải thuật77
4.2. Một số giải thuật điển hình. 78
4.2.1.Giải thuật đăng nhập chương trình. 78
4.2.2.Giải thuật thêm mới dữ liệu. 79
4.2.3.Giải thuật sửa đổi dữ liệu. 80
4.2.4.Giải thuật xóa bỏ dữ liệu. 81
4.2.5.Giải thuật tìm kiếm dữ liệu. 82
4.2.6.Giải thuật in báo cáo. 83
5.Thiết kế giao diện. 84
5.1. Nguyên tắc thiết kế giao diện. 84
5.2. Một số giao diện điển hình. 85
5.2.1. Màn hình đăng nhập chương trình. 85
5.2.2. Màn hình thông tin chung tất cả các dự án. 86
5.2.3. Màn hình thông tin chung của một dự án. 87
5.2.4. Màn hình thông tin Vốn - Kế hoạch của một dự án. 88
5.2.5. Màn hình thông tin Đấu thầu của một dự án. 89
5.2.6. Màn hình thêm mới một dự án. 90
5.2.7. Màn hình báo cáo tổng hợp tình hình thực hiện vốn đầu tư theo địa bàn. 91
5.2.8. Màn hình báo cáo tổng hợp tình hình thực hiện vốn đầu tư theo ngành kinh tế92
5.2.9 Màn hình báo cáo tổng hợp tình hình thực hiện vốn đầu tư theo thời gian. 93
5.2.10. Màn hình báo cáo theo dõi tình trạng dự án. 94
6. Cài đặt và triển khai hệ thống. 95
6.1. Yêu cầu phần mềm, phần cứng. 95
6.1.1.Yêu cầu phần mềm95
6.1.2. Yêu cầu phần cứng. 95
6.2. Tạo cơ sở dữ liệu quản lý vốn. 96
6.3. Phương hướng hoàn thiện và phát triển. 100
KẾT LUẬN102
DANH MỤC TÀI LIỆU THAM KHẢO103
PHỤ LỤC104
172 trang |
Chia sẻ: lvcdongnoi | Lượt xem: 2323 | Lượt tải: 1
Bạn đang xem trước 20 trang tài liệu 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
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 "Cha 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 "Cha 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 "Cha 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 "Cha 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 "§· lu d÷ liÖu."
Else
SgMsgBox "Cha 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 "§· lu d÷ liÖu."
Else
SgMsgBox "Cha 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:
- 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.DOC