frmzjsx.frm

一个资金管理系统的成品 开发环境：VB

      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   360
      TabIndex        =   13
      Top             =   240
      Width           =   1095
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FF8080&
      BackStyle       =   0  'Transparent
      Caption         =   "科目名称"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4560
      TabIndex        =   12
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "frmzjsx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim addrecord As Variant
'Dim usercheck As Boolean
Dim conn As New ADODB.Connection
Dim rszjsx As New ADODB.Recordset
Dim rsyskm As New ADODB.Recordset
Dim rsfygsbm As New ADODB.Recordset
'设置资金科目资金上限管理中按钮的状态
Private Sub setbuttonsyskm(bval As Boolean)
    For i = 0 To 5
       cmdyskm(i).Enabled = bval
    Next i
    cmdyskm(6).Enabled = Not bval
    Dacomyskmdm.Enabled = Not bval
    Dacomyskmmc.Enabled = Not bval
    Dacombmdm.Enabled = Not bval
    Dacombmmc.Enabled = Not bval
    Dacomzjsxje.Enabled = Not bval
    DataGrid1.Enabled = bval
    If bval Then
       cmdyskm(7).Caption = "退出"
    Else
       cmdyskm(7).Caption = "取消"
    End If
    Exit Sub
End Sub

'资金科目资金上限管理中记录增加或修改后的字段检验
Private Function zjsxcheck() As Boolean
   Dim id As Integer
   Dim str As String
   Dim note(3) As String
   note(0) = "资金科目名称和代码不能同时为空！"
   note(1) = "费用归属部门名称和代码不能为空！"
   note(2) = "此部门在该资金科目上的资金上限已经设置！"
   zjsxcheck = False
   If Dacomyskmdm.Text = "" Or Dacomyskmmc.Text = "" Then
       MsgBox note(0)
       Dacomyskmdm.SetFocus
       Exit Function
   End If
   If Dacombmdm.Text = "" Or Dacombmmc.Text = "" Then
       MsgBox note(1)
       Dacombmdm.SetFocus
       Exit Function
   End If
   id = rszjsx.Fields("xuhao")
   If addrecord = True Then
       str = "select * from zjsx where yskmmc='" & Dacomyskmmc.Text & "' and gsbmmc='" & Dacombmmc.Text & "'"
       Set rs = conn.Execute(str)
   Else
      str = "select * from zjsx where (yskmmc='" & Dacomyskmmc.Text & "' and gsbmmc='" & Dacombmmc.Text & "') and xuhao <> '" & id & "'"
      Set rs = conn.Execute(str)
   End If
   If rs.EOF Then
      zjsxcheck = True
   Else
     MsgBox note(2)
     'rszjsx.CancelBatch adAffectAllChapters
     Dacomyskmdm.SetFocus
   End If
   Exit Function
End Function
Private Sub cmdyskm_Click(Index As Integer)
  Dim i As Integer
Dim result As Boolean
Dim m_name As String
Dim bookmark As Variant
On Error GoTo adderr
Select Case Index
  Case 0  '添加按钮
       addrecord = True
       rszjsx.AddNew
       setbuttonsyskm False
       Dacomyskmdm.SetFocus
       Exit Sub
  Case 1   '修改按钮
       addrecord = False
       setbuttonsyskm False
       Dacomyskmdm.SetFocus
       Exit Sub
  Case 2   '查询按钮
      bookmark = rszjsx.bookmark
      m_name = InputBox("请输入资金科目代码或资金科目名称或归属部门代码或归属部门名称", "按资金科目代码或资金科目名称或归属部门代码或归属部门名称称搜索")
      If m_name = "" Then
         Exit Sub
      End If
      rszjsx.MoveFirst
      rszjsx.Find "yskmdm like '%" & m_name & "%'"
      If rszjsx.EOF Then
         rszjsx.MoveFirst
         rszjsx.Find "yskmmc like '%" & m_name & "%'"
         If rszjsx.EOF Then
           rszjsx.MoveFirst
           rszjsx.Find "gsbmdm like '%" & m_name & "%'"
           If rszjsx.EOF Then
              rszjsx.MoveFirst
              rszjsx.Find "gsbmmc like '%" & m_name & "%'"
              If rszjsx.EOF Then
                 MsgBox "没有设置此部门在该资金科目上的资金上限！"
                 rszjsx.bookmark = bookmark
              End If
           End If
         End If
         'rszjsx.MoveFirst
      End If
      Exit Sub
  Case 3   '删除按钮
      If MsgBox("你确认要删除该条记录吗？", vbexclaimation + vbOKCancel, "记录删除") = vbCancel Then
          Exit Sub
      End If
      conn.Execute ("delete from zjsx where xuhao=" & rszjsx.Fields("xuhao"))
      'With rszjsx
         '删除该纪录
          '.Delete
         ' .UpdateBatch adAffectCurrent
          'If .RecordCount <= 0 Then
          '   Adodc1.Enabled = False
          '   Exit Sub
          'End If
          '移到下一条
       '   .MoveNext
          '如果到文件尾，移到最后一条
        '  If .EOF Then .MoveLast
      'End With
      Exit Sub
   Case 4   '下一条
     rszjsx.MoveNext
     If rszjsx.EOF Then
        MsgBox "这是最后一个记录！"
        rszjsx.MovePrevious
     End If
     Exit Sub
  Case 5   '上一条
     rszjsx.MovePrevious
     If rszjsx.BOF Then
        MsgBox "这是第一个记录！"
        rszjsx.MoveNext
     End If
     Exit Sub
  Case 6  '保存按钮
       result = zjsxcheck()
       If result = True Then
           rszjsx.UpdateBatch adAffectCurrent
           setbuttonsyskm True
           MsgBox "保存成功！"
           rszjsx.Requery
       End If
       Exit Sub
  Case 7   ' 退出或取消按钮
       If cmdyskm(Index).Caption = "退出" Then
         Unload Me
       Else
         rszjsx.CancelUpdate
         setbuttonsyskm True
         Exit Sub
       End If
End Select
Exit Sub
adderr:
  MsgBox Err.Description
  Unload Me
End Sub
Private Sub Dacombmdm_Change()
 Dim str1 As String
 str1 = Trim(Dacombmdm.Text)
 'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
rsfygsbm.MoveFirst
If str1 <> "" Then
  rsfygsbm.Filter = "dm='" & str1 & "'"
  If Not rsfygsbm.EOF Then
    Dacombmmc.Text = rsfygsbm.Fields("gsbmmc").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub

Private Sub Dacombmmc_Change()
'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Trim(Dacombmmc.Text) <> "" Then
  rsfygsbm.Filter = "gsbmmc ='" & Trim(Dacombmmc.Text) & "'"
  If Not rsfygsbm.EOF Then
    Dacombmdm.Text = rsfygsbm.Fields("dm").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub

Private Sub Dacomyskmdm_Click(Area As Integer)
 'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Trim(Dacomyskmdm.Text) <> "" Then
  rsyskm.Filter = "dm ='" & Trim(Dacomyskmdm.Text) & "'"
  If Not rsyskm.EOF Then
    Dacomyskmmc.Text = rsyskm.Fields("yskmmc").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub

Private Sub Dacomyskmmc_Change()
 'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Trim(Dacomyskmmc.Text) <> "" Then
  rsyskm.Filter = "yskmmc= '" & Trim(Dacomyskmmc.Text) & "'"
  If Not rsyskm.EOF Then
    Dacomyskmdm.Text = rsyskm.Fields("dm").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub

Private Sub Form_Load()
Dim fieldname(6) As Variant
Dim wide(6) As Variant
Dim str As String
fieldname(0) = "序号"
fieldname(1) = "资金科目代码"
fieldname(2) = "资金科目名称"
fieldname(3) = "费用归属部门代码"
fieldname(4) = "费用归属部门名称"
fieldname(5) = "资金上限"
wide(0) = 400
wide(1) = 800
wide(2) = 1400
wide(3) = 1000
wide(4) = 1800
wide(5) = 800
'str = "Provider=SQLOLEDB.1;Password=090309;Persist Security Info=True;User ID=cw;Initial Catalog=ysgl2004;Data Source=CWSERVER"
If conn.State <> 1 Then
    conn.CursorLocation = adUseClient
    conn.Open nowconnectstring
End If
str = "SELECT a.xuhao, b.dm as yskmdm, a.yskmmc, c.dm AS gsbmdm, a.gsbmmc, a.zjsxje FROM zjsx a INNER JOIN  yskm b ON a.yskmmc = b.yskmmc INNER JOIN  fygsbm c ON a.gsbmmc = c.gsbmmc ORDER BY b.dm, c.dm"

rszjsx.Open str, conn, adOpenStatic, adLockBatchOptimistic
rsyskm.Open "select * from yskm order by dm", conn, adOpenStatic, adLockBatchOptimistic
rsfygsbm.Open "select * from fygsbm order by dm", conn, adOpenStatic, adLockBatchOptimistic
Set DataGrid1.DataSource = rszjsx
For i = 0 To 5
    DataGrid1.Columns(i).Caption = fieldname(i)
    DataGrid1.Columns(i).Width = wide(i)
    DataGrid1.Columns(i).DataField = rszjsx.Fields(i).Name
Next i
'Set Dacomyskmdm.DataSource = rszjsx
'Dacomyskmdm.DataField = rszjsx.Fields("yskmdm").Name
Set Dacomyskmdm.RowSource = rsyskm
Dacomyskmdm.ListField = rsyskm.Fields("dm").Name

Set Dacomyskmmc.DataSource = rszjsx
Dacomyskmmc.DataField = rszjsx.Fields("yskmmc").Name
Set Dacomyskmmc.RowSource = rsyskm
Dacomyskmmc.ListField = rsyskm.Fields("yskmmc").Name

'Set Dacombmdm.DataSource = rszjsx
'Dacombmdm.DataField = rszjsx.Fields("bmdm").Name
Set Dacombmdm.RowSource = rsfygsbm
Dacombmdm.ListField = rsfygsbm.Fields("dm").Name

Set Dacombmmc.DataSource = rszjsx
Dacombmmc.DataField = rszjsx.Fields("gsbmmc").Name
Set Dacombmmc.RowSource = rsfygsbm
Dacombmmc.ListField = rsfygsbm.Fields("gsbmmc").Name

Set Dacomzjsxje.DataSource = rszjsx
Dacomzjsxje.DataField = rszjsx.Fields("zjsxje").Name
End Sub

Private Sub Form_Unload(Cancel As Integer)
'rs.Close
conn.Close
End Sub