frmywadd.frm

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

  Set rs = conn.Execute("select *  from zjsx where yskmmc='" & Dacomyskmmc.Text & "' and gsbmmc='" & Dacomgsbmmc.Text & "'")
  If Not rs.EOF Then
     gsbmsx = rs.Fields("zjsxje")
  Else
     gsbmsx = 0
  End If
  rs.Close
  
  Set rs = conn.Execute("select *  from zjsx where yskmmc='" & Dacomyskmmc.Text & "' and gsbmmc='集团'")
  If Not rs.EOF Then
     jtsx = rs.Fields("zjsxje")
  Else
     jtsx = 0
  End If
  rs.Close
  
  If gsbmsx <> 0 Then
    i = gsbmze / gsbmsx
  Else
    i = 0
  End If
  If i > 0.8 Then
     If i > 0.9 Then
       If MsgBox(Dacomgsbmmc.Text & "在资金科目" & Dacomyskmmc.Text & "上的" & Dacomyslbmc.Text & "已经超过90%，请确定是否继续添加？", vbOKCancel) = vbCancel Then
          Exit Function
       End If
     Else
       If MsgBox(Dacomgsbmmc.Text & "在资金科目" & Dacomyskmmc.Text & "上的" & Dacomyslbmc.Text & "已经超过80%，请确定是否继续添加？", vbOKCancel) = vbCancel Then
          Exit Function
       End If
     End If
  End If
  
  If jtsx <> 0 Then
    i = jtze / jtsx
  Else
    i = 0
  End If
  If i > 0.8 Then
     If i > 0.95 Then
       If MsgBox("集团在资金科目" & Dacomyskmmc.Text & "上的支出已经超过90%，请确定是否继续添加？", vbOKCancel) = vbCancel Then
          Exit Function
       End If
     Else
       If MsgBox("集团在资金科目" & Dacomyskmmc.Text & "上的支出已经超过80%，请确定是否继续添加？", vbOKCancel) = vbCancel Then
          Exit Function
       End If
     End If
  End If
  
  If addrecord = True Then
     Set rs = conn.Execute("select * from kjyw where pzhm='" & Dacompzhm.Text & "'")
  Else
     Set rs = conn.Execute("select * from kjyw where pzhm='" & Dacompzhm.Text & "' and xuhao <>" & rskjyw.Fields("a.xuhao").Value)
  End If
  If Not rs.EOF Then
     MsgBox note(7)
     Dacompzhm.SetFocus
     Exit Function
  End If
  storekjyw = True
  Exit Function
End Function
Private Sub cmdkjyw_Click(Index As Integer)
  Select Case Index
     Case 0 '添加、修改或删除
        If cmdkjyw(Index).Caption = "添加" Then
           addrecord = True
           Dacomglbmdm.Text = ""
           Dacomyslbdm.Text = ""
           Dacomyskmdm.Text = ""
           Dacomgsbmdm.Text = ""
           setbuttons True
           rskjyw.AddNew
           DTfsrq.Value = Date
           txtbz.Text = " "
        Else
           If cmdkjyw(Index).Caption = "修改" Then
              addrecord = False
              setbuttons True
           Else '删除
              conn.Execute ("delete from kjyw where xuhao=" & rskjyw.Fields("xuhao"))
              rskjyw.Requery
              Exit Sub
           End If
        End If
        Dacompzhm.SetFocus
        Exit Sub
     Case 1 '保存
        If storekjyw = True Then
           'If addrecord = True Then
              rskjyw.UpdateBatch adAffectCurrent
              storehistory
              setbuttons False
              rskjyw.Requery
              If rskjyw.RecordCount = 1 Then
                Set DTfsrq.DataSource = rskjyw
                DTfsrq.DataField = rskjyw.Fields("fsrq").Name
              End If
              MsgBox "保存成功！"
           'Else
              
           'End If
           'setbuttons False
           'storehistory
           'adorefresh
           'conn.Execute ("insert into hthistory (username,act,content,date) values('" & yhmc & "','增加','','" & Date & "')")
        End If
        Exit Sub
     Case 2 '取消
        rskjyw.CancelUpdate
        setbuttons False
        Exit Sub
     Case 3 '退出
        Unload Me
  End Select
End Sub
Private Sub Dacomglbmdm_Change()
 'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Trim(Dacomglbmdm.Text) <> "" Then
  rsgkglbm.Filter = "dm ='" & Trim(Dacomglbmdm.Text) & "'"
  If Not rsgkglbm.EOF Then
    Dacomglbmmc.Text = rsgkglbm.Fields("glbmmc").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub

Private Sub Dacomglbmmc_Change()
If Trim(Dacomglbmmc.Text) <> "" Then
  rsgkglbm.Filter = "glbmmc ='" & Trim(Dacomglbmmc.Text) & "'"
  If Not rsgkglbm.EOF Then
    Dacomglbmdm.Text = rsgkglbm.Fields("dm").Value
  End If
'  Dacomlbdm.Refresh
End If
End Sub
Private Sub Dacomyslbdm_Change()
 'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Trim(Dacomyslbdm.Text) <> "" Then
  rsyskmlb.Filter = "dm ='" & Trim(Dacomyslbdm.Text) & "'"
  If Not rsyskmlb.EOF Then
    Dacomyslbmc.Text = rsyskmlb.Fields("yslbmc").Value
    Set rsyskm = conn.Execute("select * from yskm where left(dm,1)='" & Trim(Dacomyslbdm.Text) & "'")
    Set Dacomyskmdm.RowSource = rsyskm
    Dacomyskmdm.ListField = rsyskm.Fields("dm").Name
    Set Dacomyskmmc.RowSource = rsyskm
    Dacomyskmmc.ListField = rsyskm.Fields("yskmmc").Name
    If Not rsyskm.EOF Then
      Dacomyskmdm.Text = rsyskm.Fields("dm")
      Dacomyskmmc.Text = rsyskm.Fields("yskmmc")
    Else
      Dacomyskmdm.Text = ""
      Dacomyskmmc.Text = ""
    End If
  Else
    Dacomyslbmc.Text = ""
    'rsyskmlb.Filter = "dm='" & Left(Trim(Dacomyslbdm.Text), 1) & "'"
    Dacomyskmdm.Text = ""
    Dacomyskmmc.Text = ""
  End If
'  Dacomlbdm.Refresh
Else
   Dacomyslbmc.Text = " "
End If
End Sub

'Private Sub Dacomyslbdm_Click(Area As Integer)
 ' Dacomyskmdm.Text = ""
 ' Dacomyskmmc.Text = ""
'End Sub

Private Sub Dacomyslbmc_Change()
If Trim(Dacomyslbmc.Text) <> "" Then
  rsyskmlb.Filter = "yslbmc ='" & Trim(Dacomyslbmc.Text) & "'"
  If Not rsgkglbm.EOF Then
    Dacomyslbdm.Text = rsyskmlb.Fields("dm").Value
    Set rsyskm = conn.Execute("select * from yskm where left(dm,1)='" & Trim(Dacomyslbdm.Text) & "'")
    Set Dacomyskmdm.RowSource = rsyskm
    Dacomyskmdm.ListField = rsyskm.Fields("dm").Name
    Set Dacomyskmmc.RowSource = rsyskm
    Dacomyskmmc.ListField = rsyskm.Fields("yskmmc").Name
    If Not rsyskm.EOF Then
      Dacomyskmdm.Text = rsyskm.Fields("dm")
      Dacomyskmmc.Text = rsyskm.Fields("yskmmc")
     Else
      Dacomyskmdm.Text = ""
      Dacomyskmmc.Text = ""
    End If
  Else
    Dacomyslbdm.Text = ""
    'rsyskmlb.Filter = "dm='" & Left(Trim(Dacomyslbdm.Text), 1) & "'"
    Dacomyskmdm.Text = ""
    Dacomyskmmc.Text = ""
  End If
'  Dacomlbdm.Refresh
End If
End Sub
Private Sub Dacomyskmdm_Change()
 'Set rs = conn.Execute("select * from yskmlb where dm='" & Left(Dacomdm.Text, 1) & "'")
If Trim(Dacomyskmdm.Text) <> "" Then
  Set rsyskm = conn.Execute("select * from yskm where dm ='" & Trim(Dacomyskmdm.Text) & "'")
  If Not rsyskm.EOF Then
    Dacomyskmmc.Text = rsyskm.Fields("yskmmc").Value
    'rsyskmlb.Filter = "dm='" & Left(Trim(Dacomyslbdm.Text), 1) & "'"
    Dacomyslbdm.Text = Left(rsyskm.Fields("dm").Value, 1)
    Dacomyslbmc.Text = rsyskm.Fields("yslbmc").Value
  Else
    Dacomyskmmc.Text = ""
    'rsyskmlb.Filter = "dm='" & Left(Trim(Dacomyslbdm.Text), 1) & "'"
    Dacomyslbdm.Text = ""
    Dacomyslbmc.Text = ""
  End If
'  Dacomlbdm.Refresh
End If
End Sub
Private Sub Dacomyskmmc_Change()
If Trim(Dacomyskmmc.Text) <> "" Then
  Set rsyskm = conn.Execute("select * from yskm where yskmmc ='" & Trim(Dacomyskmmc.Text) & "'")
  If Not rsyskm.EOF Then
    Dacomyskmdm.Text = rsyskm.Fields("dm").Value
    'rsyskmlb.Filter = "dm='" & Left(Trim(Dacomyskmdm.Text), 1) & "'"
    Dacomyslbdm.Text = Left(Dacomyskmdm.Text, 1)
    Dacomyslbmc.Text = rsyskm.Fields("yslbmc").Value
  Else
    Dacomyskmdm.Text = ""
    'rsyskmlb.Filter = "dm='" & Left(Trim(Dacomyslbdm.Text), 1) & "'"
    Dacomyslbdm.Text = ""
    Dacomyslbmc.Text = ""
  End If
'  Dacomlbdm.Refresh
End If
End Sub

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

Private Sub Form_Load()
Dim fieldname(13) As Variant
Dim wide(13) As Variant
Dim str As String
fieldname(0) = "序号"
fieldname(1) = "票据号码"
fieldname(2) = "票据类别名称"
fieldname(3) = "发生日期"
fieldname(4) = "归口管理部门代码"
fieldname(5) = "归口管理部门"
fieldname(6) = "资金科目类别代码"
fieldname(7) = "资金科目类别"
fieldname(8) = "资金科目代码"
fieldname(9) = "资金科目名称"
fieldname(10) = "费用归属部门代码"
fieldname(11) = "费用归属部门"
fieldname(12) = "业务金额"
fieldname(13) = "备注"
wide(0) = 400
wide(1) = 800
wide(2) = 1400
wide(3) = 1000
wide(4) = 1000
wide(5) = 1400
wide(6) = 1000
wide(7) = 1400
wide(8) = 1000
wide(9) = 1400
wide(10) = 1000
wide(11) = 1400
wide(12) = 1000
wide(13) = 1400

'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, a.pzhm,a.pzlbmc, a.fsrq , e.dm as glbmdm,a.glbmmc,b.dm AS yskmlbdm, a.yslbmc, c.dm AS yskmdm,a.yskmmc, d.dm AS gsbmdm, a.gsbmmc, a.ywje, a.bz FROM kjyw a INNER JOIN  yskmlb b ON a.yslbmc = b.yslbmc INNER JOIN  yskm c ON a.yskmmc = c.yskmmc INNER JOIN  fygsbm d ON a.gsbmmc = d.gsbmmc INNER JOIN  gkglbm e ON a.glbmmc = e.glbmmc ORDER BY a.pzhm"
rskjyw.Open str, conn, adOpenStatic, adLockBatchOptimistic
rsyskm.Open "select * from yskm order by dm", conn, adOpenStatic, adLockBatchOptimistic
rspzlb.Open "select * from pzlb", conn, adOpenStatic, adLockBatchOptimistic
rsyskmlb.Open "select * from yskmlb order by dm", conn, adOpenStatic, adLockBatchOptimistic
rsfygsbm.Open "select * from fygsbm order by dm", conn, adOpenStatic, adLockBatchOptimistic
rsgkglbm.Open "select * from gkglbm order by dm", conn, adOpenStatic, adLockBatchOptimistic
Set DataGrid1.DataSource = rskjyw
For i = 0 To 12
    DataGrid1.Columns(i).Caption = fieldname(i)
    DataGrid1.Columns(i).Width = wide(i)
    DataGrid1.Columns(i).DataField = rskjyw.Fields(i).Name
Next i
Set Dacompzhm.DataSource = rskjyw
Dacompzhm.DataField = rskjyw.Fields("pzhm").Name
'Set Dacompzhm.RowSource = rskjyw
'Dacomyskmdm.ListField = rskjyw.Fields("dm").Name

Set Dacompzlbmc.DataSource = rskjyw
Dacompzlbmc.DataField = rspzlb.Fields("pzlbmc").Name
Set Dacompzlbmc.RowSource = rspzlb
Dacompzlbmc.ListField = rspzlb.Fields("pzlbmc").Name


If rskjyw.RecordCount <> 0 Then
   Set DTfsrq.DataSource = rskjyw
   DTfsrq.DataField = rskjyw.Fields("fsrq").Name
Else
    DTfsrq.Value = Date
End If
Set Dacomglbmdm.RowSource = rsgkglbm
Dacomglbmdm.ListField = rsgkglbm.Fields("dm").Name

Set Dacomglbmmc.DataSource = rskjyw
Dacomglbmmc.DataField = rskjyw.Fields("glbmmc").Name
Set Dacomglbmmc.RowSource = rsgkglbm
Dacomglbmmc.ListField = rsgkglbm.Fields("glbmmc").Name

Set Dacomyslbdm.RowSource = rsyskmlb
Dacomyslbdm.ListField = rsyskmlb.Fields("dm").Name

Set Dacomyslbmc.DataSource = rskjyw
Dacomyslbmc.DataField = rskjyw.Fields("yslbmc").Name
Set Dacomyslbmc.RowSource = rsyskmlb
Dacomyslbmc.ListField = rsyskmlb.Fields("yslbmc").Name

Set Dacomyskmdm.RowSource = rsyskm
Dacomyskmdm.ListField = rsyskm.Fields("dm").Name

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

Set Dacomgsbmdm.RowSource = rsfygsbm
Dacomgsbmdm.ListField = rsfygsbm.Fields("dm").Name

Set Dacomgsbmmc.DataSource = rskjyw
Dacomgsbmmc.DataField = rskjyw.Fields("gsbmmc").Name
Set Dacomgsbmmc.RowSource = rsfygsbm
Dacomgsbmmc.ListField = rsfygsbm.Fields("gsbmmc").Name

Set Dacomywje.DataSource = rskjyw
Dacomywje.DataField = rskjyw.Fields("ywje").Name

Set txtbz.DataSource = rskjyw
txtbz.DataField = rskjyw.Fields("bz").Name

If operatetype = 1 Then
  cmdkjyw(0).Caption = "添加"
Else
  If operatetype = 2 Then
    cmdkjyw(0).Caption = "修改"
  Else
    cmdkjyw(0).Caption = "删除"
  End If
End If
End Sub

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