II. BÁI TOÁN QUẢN Lí NGUỒN VỐN DỰ ÁN ĐẦU TƯ TẠI SỞ KẾ HOẠCH VÀ
6. Cài đặt và triển khai hệ thống
6.1. Yờu cầu phần mềm, phần cứng
6.1.1.Yờu cầu phần mềm
Phần mềm được viết bằng ngụn ngữ Visual Basic 6.0, với cỏc bảng dữ liệu được xõy dựng trờn hệ quản trị CSDL SQL Server 2000. Bỏo cỏo đầu ra sử dụng Crystal Report, cú thể kết nối với một số cỏc ứng dụng khỏc như Excel, Access, Word. Phần mềm đỏp ứng được một số đặc tớnh chung của phần mềm hiện đại như:
Dễ sử dụng
Chống sao chộp
Tương thớch với cỏc phần mềm khỏc
Tương thớch với nhiều thiết bị ngoại vi
6.1.2. Yờu cầu phần cứng
Phần mềm này rất dễ thớch nghi với cỏc loại mỏy kể cả mỏy cấu hỡnh thấp và mỏy cú cấu hỡnh cao,cú thể kết nối với mỏy in để xuất ra bỏo cỏo khi cần thiết
6.2. Tạo cơ sở dữ liợ̀u quản lý vụ́n
Copy file QuanLyVon.bak vào ổ C của mỏy chủ
Tại mỏy chủ, bấm Start --- Programs ---- Microsoft SQL
Server--- Enterprise Manager để vào SLQ, khi cõy bờn trỏi hiện ra, bấm vào cỏc nỳt dấu + để hiện ra như cõy bờn dưới:
Kớch phải chuột vào Databases (ở dũng thứ 5 từ trờn cựng xuống), sẽ hiện menu và đưa chuột tới dũng “All tasks” sẽ hiện tiếp menu và chọn “Restore database”
Nhập QuanLyVon vào mục Restore as database. Chọn From device và bấm
Cửa sổ hiện ra như sau
Bấm Add hiện bảng
Bấm nỳt lệnh sẽ hiện bảng chọn File dữ liệu đó được backup
(đưa đến file cú tờn là QuanLyVon.bak lưu trữ trong ổ CD và đó được copy sang ổ C)
Bấm Ok sẽ quay lại màn hỡnh
Bṍm option
Nếu muốn thay đổi nơi chứa dữ liệu thỡ sửa vào
C:\Program Files\Microsoft SQL Server\MSSQL\Data\QuanLyVon.mdf Và
C:\Program Files\Microsoft SQL Server\MSSQL\Data\ QuanLyVon _log.ldf Nếu khụng thỡ bấm OK
6.3. Phương hướng hoàn thiện và phỏt triển
Phần mềm này đang trong giai đoạn thực hiện, nờn chưa thực hiện được đầy đủ cỏc chức năng trong yờu cầu. Dự kiến trong tương lai phần mềm sẽ được xõy dựng một cỏch hoàn thiện thành một hệ thống thụng tin chuyờn dụng trong Sở Kế hoạch và Đầu tư tỉnh Điện Biờn và mở rộng sang quản lý nguồn vốn đầu tư cho cỏc sở, ban, ngành khỏc. Với hệ quản trị cơ sở dữ liệu
SQL Server hệ thống sẽ mở rộng kho lưu trữ dữ liệu để phục vụ cho cụng tỏc quản lý dự ỏn đầu tư trong tương lai.
Để sử dụng hệ thống một cỏch cú hiệu quả phần mềm sẽ tớch hợp thờm tớnh năng đào tạo người sử dụng để kết hợp với người hướng dẫn sử dụng hệ thống. Ngoài ra phải cú mục hỗ trợ người sử dụng, thành lập trung tõm hỗ trợ người sử dụng, trung tõm này cú thể thực thi cỏc cụng việc:
Cài đặt phần cứng hoặc phần mềm.
Thảo luận với người sử dụng để viết cỏc chương trỡnh với ngụn ngữ thế hệ thứ tư.
Trớch rỳt dữ liệu từ CSDL của tổ chức vào cỏc mỏy tớnh cỏ nhõn.
Tạo tài khoản cho người sử dụng
Trả lời cỏc cõu hỏi theo nhu cầu
Tạo cỏc trang minh họa để tham khảo phần cứng và phần mềm. Làm việc với người sử dụng để đưa ra cỏc đề nghị thay đổi hệ thống.
KẾT LUẬN
Ngày nay cụng nghệ thụng tin được xem là một lĩnh vực cú ý nghĩa sống cũn đối với sự phỏt triển của đời sống xó hội. Sự tỏc động rộng lớn và sõu sắc của nú vào mọi lĩnh vực, mọi ngành nghề đó tạo cho nú một chỗ đứng khụng thể thiếu đối với sự phỏt triển của cỏc doanh nghiệp núi riờng và của toàn xó hội núi chung.
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ư.
Phần mềm đó đạt được một số yờu cầu đặt ra như: cho biết thụng tin về dự toỏn vốn, kế hoạch vốn, tỡnh hỡnh thực hiện và giải ngõn vốn dự ỏn đầu tư. Đưa ra được cỏc bỏo cỏo về tỡnh hỡnh sử dụng vốn và cỏc bỏo cỏo cú thể kết xuất sang Microsoft Excel. Điều này giỳp cho việc kiểm tra và tổng hợp số liệu một cỏch chớnh xỏc và đỏp ứng được cỏc yờu cầu khi cần thiết.
Tuy nhiờn chương trỡnh quản lý nguồn vốn dự ỏn đầu tư này vẫn chưa phải là một chương trỡnh thực sự hoàn thiện do cũn cú những hạn chế về mặt thực tế, kinh nghiệm lập trỡnh cũng như về thời gian. Trong thời gian tới, nếu điều kiện cho phộp em sẽ cố gắng hoàn thiện chương trỡnh hơn nữa.
DANH MỤC TÀI LIỆU THAM KHẢO
1. Giỏo trỡnh hệ thống thụng tin quản lý _ TS. Trương Văn Tỳ, TS. Trần Thị Song Minh
2. Giỏo trỡnh cấu trỳc dữ liệu và giải thuật_ PGS. TS. Hàn Viết Thuận. 3. Giỏo trỡnh Cơ sở dữ liệu _ THS. Trần Cụng Uẩn
4. Lập trỡnh ứng dụng chuyờn nghiệp SQL Server 2000- MK Pub
5. Microsoft Visual Basic 6.0 Lập trỡnh cơ sở dữ liệu_ Nguyễn Thị Ngọc Mai
6. Giỏo trỡnh quản lý dự ỏn đầu tư _ TS. Từ Quang Phương
7. www.cic .com.vn
8. www.dienbien .gov.vn
PHỤ LỤC
Một số đoạn code chương trỡnh
Code module đăng nhập
Option Explicit Sub Main() Call GetInfo FrLoginUser.Show End Sub
Code module BaoCao
Option Explicit
Public Sub SqlChildStr(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
sqlchild = TenTruong & " in ("
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 SqlChildStr(Bang, TenTruong, rs.Fields(0).Value) Else
sqlchild = sqlchild & "'" & rs.Fields(0).Value & "'," End If rs.MoveNext rs1.Close Wend End If
sqlchild = sqlchild & "'" & id & "'," End Sub
Public Sub SqlTree(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) & ")" Else
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)
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
Public Function KiemTraNodeChild(sNode As String, Bang As String) As Boolean Dim rs As New ADODB.Recordset
Dim sql As String
sql = "Select nCount=Count(*) FROM " & Bang & " Where parent='" & sNode & "'" rs.Open sql, gConn, 3, 3 If rs("nCount") >= 1 Then KiemTraNodeChild = True Else KiemTraNodeChild = False End If End Function
Public Function FgThietke(MaDA As String) As String Dim rs As New ADODB.Recordset
gSQL="SELECTdbo.Ps_CongSuat.CongSuat,dbo.Td_DonViTinh.TenDonViTinh FROM dbo.Ps_DuAn INNER JOIN dbo.Ps_CongSuat ON dbo.Ps_DuAn.MaDuAn = dbo.Ps_CongSuat.MaDuAn INNER JOIN dbo.Td_DonViTinh ON dbo.Ps_CongSuat.MaDonViTinh = dbo.Td_DonViTinh.MaDonViTinh where ps_duan.maduan='" & MaDA & "' and TinhSuatDauTu=1"
rs.Open gSQL, gConn, 3, 3 If rs.RecordCount > 0 Then
FgThietke = rs.Fields("Congsuat").Value & rs.Fields("Tendonvitinh").Value Else
FgThietke = "" End If
rs.Close End Function
Public Sub SqlChildStr_Rs(Bang As String, TenTruong As String, rsDL As ADODB.Recordset)
Dim sql As String
Dim rs As New ADODB.Recordset Dim rs1 As New ADODB.Recordset Dim StrNode As String
If rsDL.RecordCount > 0 Then rsDL.MoveFirst
While Not rsDL.EOF
sqlchild = sqlchild & "'" & rsDL.Fields(TenTruong).Value & "',"
rs.Open "select " & TenTruong & " from " & Bang & " where parent='" & rsDL.Fields(TenTruong).Value & "'", gConn, adOpenStatic, adLockReadOnly If rs.RecordCount > 0 Then
rs.MoveFirst While Not rs.EOF
sqlchild = sqlchild & "'" & rs.Fields(0).Value & "',"
rs1.Open "select " & TenTruong & " from " & Bang & " where parent='" & rs.Fields(0).Value & "'", gConn, adOpenStatic, adLockReadOnly
If rs1.RecordCount > 0 Then
Call SqlChildStr(Bang, TenTruong, rs.Fields(0).Value) End If rs.MoveNext rs1.Close Wend End If rsDL.MoveNext rs.Close Wend
sqlchild = Mid(sqlchild, 1, Len(sqlchild) - 1) & ")" End If
End Sub
Public Function FgDiaban(MaDA As String) As String Dim rs As New ADODB.Recordset
gSQL = "SELECT dbo.Td_DiaPhuong.TenDiaPhuong FROM dbo.Ps_DuAn INNER JOIN dbo.Td_DiaPhuong ON dbo.Ps_DuAn.MaDiaPhuong = dbo.Td_DiaPhuong.MaDiaPhuong where ps_duan.maduan='" & MaDA & "' " rs.Open gSQL, gConn, 3, 3 If rs.RecordCount > 0 Then FgDiaban = rs.Fields("TenDiaphuong").Value Else FgDiaban = "" End If rs.Close End Function
Public Function FgDanhSachNguoiSuDung() As String Dim rs1 As New ADODB.Recordset
gSQL = "SELECT dbo.Ht_PsQuyenUser.UserID2, dbo.Ht_TdNguoiSuDung.UserName, dbo.Ht_PsQuyenUser.MaQuyen, dbo.Ht_PsQuyenUser.UserID" & _
" FROM dbo.Ht_TdNguoiSuDung INNER JOIN " & _
" dbo.Ht_PsQuyenUser ON dbo.Ht_TdNguoiSuDung.UserID = dbo.Ht_PsQuyenUser.UserID2 Where dbo.Ht_PsQuyenUser.UserID ='" & gUserID & "' and MaQuyen<>'" & Q_KHONGTRUYCAP & "'"
rs1.Open gSQL, gConn, 3, 3
FgDanhSachNguoiSuDung = " PS_DuAn.UserID in ('" & gUserID & "'," If rs1.RecordCount > 0 Then
While Not rs1.EOF
FgDanhSachNguoiSuDung = FgDanhSachNguoiSuDung & "'" & rs1.Fields("UserID2").Value & "'," rs1.MoveNext Wend End If FgDanhSachNguoiSuDung = Mid(FgDanhSachNguoiSuDung, 1, Len(FgDanhSachNguoiSuDung) - 1) & ")" rs1.Close End Function
Public Sub SqlChildStr1(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
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 SqlChildStr1(Bang, TenTruong, rs.Fields(0).Value) Else
sqlchild = sqlchild & "'" & rs.Fields(0).Value & "'," End If
rs.MoveNext rs1.Close Wend End If
sqlchild = sqlchild & "'" & id & "'," End Sub
Code Form LoginUser
Option Explicit
Private Sub CmPassChapNhan_Click() Dim lUserID As String
Dim lUserName As String Dim lPass As String 'Screen.MousePointer = 11 If Trim(Me.TxPass) = "" Then
SgMsgBox "Cần phải nhập mật khẩu" Me.TxPass.SetFocus
Exit Sub End If
If Trim(Me.TxUserID) = "" Then
SgMsgBox "Cần phải nhập ngời sử dụng" Me.TxUserID.SetFocus
Exit Sub End If
'classDES.DecryptString
Set gRs = New ADODB.Recordset
'gSQL = "SELECT * FROM Ht_TdNguoiSuDung Where UserID = '" & UCase(TxUserID.Text) & "' And PassWord = '" & UCase(TxPass.Text) & "'"
gSQL = "SELECT * FROM Ht_TdNguoiSuDung"
gRs.Open gSQL, gConn, adOpenKeyset, adLockReadOnly Do While Not gRs.EOF
If case(Me.TxPass.Text)= UCase(classDES.DecryptString(gRs.Fields("Password"))) And UCase(Me.TxUserID.Text) = UCase(classDES.DecryptString(gRs.Fields("UserID"))) Then Exit Do End If gRs.MoveNext Loop If gRs.EOF Then gRs.Close
SgMsgBox "Kiểm tra lại UserID và PassWord" TxPass.SetFocus Exit Sub End If gUserID = UCase(TxUserID.Text) gUserNameID = classDES.DecryptString(gRs!UserName) gRs.Close
SaveSetting "QLVON", App.Path, "UserID", TxUserID.Text
SaveSetting "QLVON", App.Path, "PWD", CStr(ChSavePass.Value) Me.Hide
FrTreeData.Show
Private Sub CmPassHuyBo_Click() Unload Me
End Sub
Private Sub Form_Load()
Dim mLan As Integer 'Lần kết nối hỏng 'Lấy connect
gCatalog = NullText(GetSetting("QLVON", App.Path, "Catalog", "")) gSource = GetSetting("QLVON", App.Path, "Source", "")
gPSW = GetSetting("QLVON", App.Path, "pSQL", "")
gUserIDSQL = GetSetting("QLVON", App.Path, "UserIDSQL", "") If gCatalog = "" Then
gCatalog = "QuanLyVon" gSource = "(Local)" End If
Me.Caption = "Cơ sở dữ liệu: " & gCatalog On Error GoTo err
With gConn
.CursorLocation = adUseClient .CommandTimeout = 0
gConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" & gUserIDSQL & ";Password=" & gPSW & ";Initial Catalog=" & gCatalog & ";Data Source=" & gSource
.Open gConnectionString GoTo Cont
err:
FrLogin.Show 1
If gConnOK = False Then End
End If End With Cont:
On Error Resume Next
SaveSetting "QLVON", App.Path, "Catalog", gCatalog SaveSetting "QLVON", App.Path, "Source", gSource SaveSetting "QLVON", App.Path, "ODBC", gODBC SaveSetting "QLVON", App.Path, "pSQL", gPSW
SaveSetting "QLVON", App.Path, "UserIDSQL", gUserIDSQL TxUserID.Text = GetSetting("QLVON", App.Path, "UserID", "") If GetSetting("QLVON", App.Path, "PWD", "") = "1" Then Set gRs = New ADODB.Recordset
gSQL = "SELECT * FROM Ht_TdNguoiSuDung"
gRs.Open gSQL, gConn, adOpenKeyset, adLockReadOnly Do While Not gRs.EOF
If UCase(Me.TxUserID.Text) = UCase(classDES.DecryptString(gRs.Fields("UserID"))) Then Exit Do End If gRs.MoveNext Loop
If Not gRs.EOF Then
TxPass.Text = classDES.DecryptString(gRs!Password) End If
gRs.Close
End If
Call SetFontTitle End Sub
Private Sub Form_Unload(Cancel As Integer) gConn.Close
End End Sub
Private Sub TxPass_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then
Call CmPassChapNhan_Click End If
End Sub
Private Sub TxUserID_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then
Call CmPassChapNhan_Click End If
End Sub
Code Form TongHopDuLieuDuAn
Option Explicit
Dim rstree As New ADODB.Recordset Dim RsNode As New ADODB.Recordset Dim RsDA As New ADODB.Recordset Dim Key As Long
'Dim sqlchild As String Dim SQLDA_Last As String Dim T_Style() As Style
Dim BangTam_TinhTrang As String, BangTreeDuan As String Dim KiemTraTinhTrang As Boolean
Private WithEvents m_Menus As cMenus Private Sub cboDonViTheoDoi_Click() Dim rs As New ADODB.Recordset Dim rsTong As New ADODB.Recordset Dim sqlTong As String
If Me.cboDonViTheoDoi.Text = "Tất cả" Then gSQL = "select * from " & gTmp_DuAn
sqlTong = "select sum(TMDT),sum(DuToan) from " & gTmp_DuAn Else
rs.Open "select * from Td_DonVi where TenDonVi='" & Me.cboDonViTheoDoi.Text & "'", gConn, adOpenStatic, adLockReadOnly
If rs.RecordCount > 0 Then
gSQL = "select * 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 & "' ) "
sqlTong = "select sum(TMDT),sum(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 * from " & gTmp_DuAn
sqlTong = "select sum(TMDT),sum(DuToan) from " & gTmp_DuAn End If rs.Close End If With Me.adoDuan .Password = gPSW .ConnectionString = gConn.ConnectionString .CommandType = adCmdText .RecordSource = gSQL .Refresh End With
rsTong.Open sqlTong, 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 Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) Select Case KeyCode
Case 112 'F1: thêm mới
Call Toolbar1_ButtonClick(Me.Toolbar1.Buttons(1)) Case 113 'F2: Sửa
Call Toolbar1_ButtonClick(Me.Toolbar1.Buttons(2)) Case 114 'F3:Xoá
Call Toolbar1_ButtonClick(Me.Toolbar1.Buttons(3)) Case 115 'F4:Xem thông tin
Call Toolbar1_ButtonClick(Me.Toolbar1.Buttons(4)) End Select
End Sub
Private Sub Form_Load() Dim Node As Node
gDonVi = "Sở Kế hoạch và Đầu t"
gTenChuQuan = "UBND tỉnh ĐIện Biên" Set m_Menus = New cMenus
gCOLLATE = " COLLATE SQL_Latin1_General_Cp437_BIN"
gSQL = "select * from dbo.sysobjects where id = object_id(N'[dbo]. [TuDienDonVi]') and OBJECTPROPERTY(id, N'IsUserTable') = 1"
gRs.Open gSQL, gConn, adOpenStatic, adLockReadOnly If gRs.RecordCount > 0 Then
Call Get_TTDV 'Lay thong tin don vi End If
gRs.Close
'gLoaihienthi = "Td_Diaphuong"
gLoaihienthi = GetSetting("HienThiMenu", App.Path, "HienThiMenu", "") If gLoaihienthi = "" Then
gLoaihienthi = "Td_Diaphuong" End If
If InStr(gLoaihienthi, "Tonghop") = 0 Then
Call gLenTreeCacDuAn1(gLoaihienthi, Mid(gLoaihienthi, 4)) Key = 1
Else
tmp_treeTT = FgTongHopCay(CDbl(Mid(gLoaihienthi, 9)), "Tree") Call gTonghopTreeDuAn(tmp_treeTT)
Call gLenTreeCacDuAn(BangTreeDuan) End If
Call TatCaCacDuAn Call LoadDanhMuc
Call LoadMenuDong 'Đa vào 1 module để khi thay đổi cây thì gọi module này để load lại cây; phải khai báo Public
Call gTuDienThamso gNgayHeThong = Date Call AddStyle
If UCase(gUserID) <> "ADMIN" Then Me.mnuPhanQuyen.Enabled = False End If
Me.StatusBar1.Panels(1).Text = "Ngời sử dụng: " & gUserNameID Me.StatusBar1.Panels(3).Text = "Ngày: " & Date
Call AddDonViQuanLy Dim i As Integer For i = 32 To 258 .ItemImage(i) = "Report" Next i End With End Sub
Public Sub LoadMenuDong() Call LoadMenuDMS Call SgMenuThamSo(Me) With m_Menus
Set .ImageList = imlMenus Call .CreateFromForm(Me) .font = Me.font .DrawStyle = mds_XP End With End Sub
Public Sub LoadMenuBaoCaoDong(Frm As Form, mMenu As String) 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_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
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