Cài đặt và triển khai hệ thống

Một phần của tài liệu b1068 (Trang 90 - 144)

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.

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 nhp

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

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

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

gSQL = "Select * From Sysobjects Where Xtype='U' And Name Like '_TMP%'

Một phần của tài liệu b1068 (Trang 90 - 144)

Tải bản đầy đủ (DOC)

(144 trang)
w