form2.frm

一个管理党费 的vb程序 很实用的程序 可以看 所有代码

    rec3.AddNew
    rec3(0) = Trim(CStr(Text1.Text))
    rec3(1) = Trim(CStr(Text2.Text))
    rec3(2) = Trim(CStr(Text3.Text))
    rec3(3) = Round(CDbl(Label20.Caption), 2)
    rec3(4) = Round(CDbl(Text4.Text), 2)
    rec3(5) = Round(CDbl(Text5.Text), 2)
    rec3(6) = Round(CDbl(Text6.Text), 2)
    rec3(7) = Round(CDbl(Text7.Text), 2)
    rec3(8) = Round(CDbl(Label17.Caption), 2)
    rec3(9) = Round(CDbl(Label18.Caption), 2)
    rec3(10) = Round(CDbl(Label19.Caption), 2)
       If Check1.Value = 0 Then
           rec3(13) = "未交"
       Else
           rec3(13) = "已交"
       End If
       If Check2.Value = 0 Then
           rec3(14) = "未交"
       Else
           rec3(14) = "已交"
       End If
       If Check3.Value = 0 Then
           rec3(15) = "未交"
       Else
           rec3(15) = "已交"
       End If
       If Check4.Value = 0 Then
           rec3(16) = "未交"
       Else
           rec3(16) = "已交"
       End If
       If Check5.Value = 0 Then
           rec3(17) = "未交"
       Else
           rec3(17) = "已交"
       End If
       If Check6.Value = 0 Then
           rec3(18) = "未交"
       Else
           rec3(18) = "已交"
       End If
       If Check7.Value = 0 Then
           rec3(19) = "未交"
       Else
           rec3(19) = "已交"
       End If
       If Check8.Value = 0 Then
           rec3(20) = "未交"
       Else
           rec3(20) = "已交"
       End If
       If Check9.Value = 0 Then
           rec3(21) = "未交"
       Else
           rec3(21) = "已交"
       End If
       If Check10.Value = 0 Then
           rec3(22) = "未交"
       Else
           rec3(22) = "已交"
       End If
       If Check11.Value = 0 Then
           rec3(23) = "未交"
       Else
           rec3(23) = "已交"
       End If
       If Check12.Value = 0 Then
           rec3(24) = "未交"
       Else
           rec3(24) = "已交"
       End If
       
       If Option13.Value = True Then
          rec3("党员性质") = "正式"
       ElseIf Option14.Value = True Then
          rec3("党员性质") = "预备"
       End If
       rec3("所属总支") = Combo1.Text
       If rec3("所属总支") = "请选择所属部门" Then rec3("所属总支") = "暂无记录"
   rec3.Update
   MsgBox "新的记录，已经添加成功"
End If
 rec3.Close
End Sub

Private Sub Command11_Click()
If Trim(Text1.Text) = "" Then
   MsgBox "没有要删除的记录"
   Exit Sub
End If
Set cnn = New ADODB.Connection
cnn.Open cnstr
Set rec2 = New ADODB.Recordset
sqlstr = "select * from teacher2003 where 工资号='" & Trim(CStr(Text1.Text)) & "'"
rec2.Open sqlstr, cnn, 3, 2
If rec2.RecordCount >= 1 Then
   anser = MsgBox("确认要删除吗", vbYesNo)
   If anser = vbYes Then
      rec2.Delete
      nowrecord = 1
      Call cleartext
      MsgBox "删除成功"
   End If
   delflag = True
End If
Label16.Caption = "查询已经过期,请重新查询"
End Sub

Private Sub Command12_Click()
If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" Or Trim(Text3.Text) = "" Or Trim(Text3.Text) = "" Or Trim(Text4.Text) = "" Or Trim(Text5.Text) = "" Or Trim(Text6.Text) = "" Or Trim(Text7.Text) = "" Or Trim(Label17.Caption) = "" Or Trim(Label18.Caption) = "" Or Trim(Label19.Caption) = "" Or Trim(Label20.Caption) = "" Then
    MsgBox "不允许导入数据不完全的记录", , "I/O错误"
    Exit Sub
End If

Set cnn = New ADODB.Connection
cnn.Open cnstr
Set rec1 = New ADODB.Recordset
sqlstr = "select * from teacher2003 where 工资号='" & Trim(CStr(Text1.Text)) & "'"
rec1.Open sqlstr, cnn, 3, 2
If rec1.RecordCount >= 1 Then
   MsgBox "已存在该记录，请点击修改记录按钮保存修改"
Else
  rec1.AddNew
       rec1(0) = Trim(CStr(Text1.Text))
       rec1(1) = Trim(CStr(Text2.Text))
       rec1(2) = Trim(CStr(Text3.Text))
       rec1(3) = Round(CDbl(Label20.Caption), 2)
       rec1(4) = Round(CDbl(Text4.Text), 2)
       rec1(5) = Round(CDbl(Text5.Text), 2)
       rec1(6) = Round(CDbl(Text6.Text), 2)
       rec1(7) = Round(CDbl(Text7.Text), 2)
       rec1(8) = Round(CDbl(Label17.Caption), 2)
       rec1(9) = Round(CDbl(Label18.Caption), 2)
       rec1(10) = Round(CDbl(Label19.Caption), 2)
       If Check1.Value = 0 Then
           rec1(13) = "未交"
       Else
           rec1(13) = "已交"
       End If
       If Check2.Value = 0 Then
           rec1(14) = "未交"
       Else
           rec1(14) = "已交"
       End If
       If Check3.Value = 0 Then
           rec1(15) = "未交"
       Else
           rec1(15) = "已交"
       End If
       If Check4.Value = 0 Then
           rec1(16) = "未交"
       Else
           rec1(16) = "已交"
       End If
       If Check5.Value = 0 Then
           rec1(17) = "未交"
       Else
           rec1(17) = "已交"
       End If
       If Check6.Value = 0 Then
           rec1(18) = "未交"
       Else
           rec1(18) = "已交"
       End If
       If Check7.Value = 0 Then
           rec1(19) = "未交"
       Else
           rec1(19) = "已交"
       End If
       If Check8.Value = 0 Then
           rec1(20) = "未交"
       Else
           rec1(20) = "已交"
       End If
       If Check9.Value = 0 Then
           rec1(21) = "未交"
       Else
           rec1(21) = "已交"
       End If
       If Check10.Value = 0 Then
           rec1(22) = "未交"
       Else
           rec1(22) = "已交"
       End If
       If Check11.Value = 0 Then
           rec1(23) = "未交"
       Else
           rec1(23) = "已交"
       End If
       If Check12.Value = 0 Then
           rec1(24) = "未交"
       Else
           rec1(24) = "已交"
       End If
       
       If Option13.Value = True Then
          rec1("党员性质") = "正式"
       ElseIf Option14.Value = True Then
          rec1("党员性质") = "预备"
       End If
       rec1("所属总支") = Combo1.Text
       If rec1("所属总支") = "请选择所属部门" Then rec1("所属总支") = "暂无记录"
  rec1.Update
  MsgBox "成功将记录导入到数据库中", , "导入成功"
End If
rec1.Close
End Sub

Private Sub Command13_Click()
If Trim(CStr(Text4.Text)) = "" Or Trim(CStr(Text5.Text)) = "" Or Trim(CStr(Text6.Text)) = "" Or Trim(CStr(Text7.Text)) = "" Then
   MsgBox "必要数据输入不完整", , "输入错误"
   Exit Sub
End If
If IsNumeric(Text4.Text) = False Or IsNumeric(Text5.Text) = False Or IsNumeric(Text6.Text) = False Or IsNumeric(Text7.Text) = False Then
   MsgBox "所输数据类型错误，请检查后再计算", , "输入错误"
   Exit Sub
End If

sum0 = CDbl(Text4.Text) + CDbl(Text5.Text) + CDbl(Text6.Text) + CDbl(Text7.Text)
sum0 = Round(sum0, 2)

If sum0 <= 800 Then
      shui0 = 0
ElseIf sum0 > 800 And sum0 <= 1300 Then
      shui0 = sum0 * 0.05
ElseIf sum0 > 1300 And sum0 <= 2800 Then
      shui0 = sum0 * 0.1
      If shui0 >= 25 Then shui0 = 25
ElseIf sum0 > 2800 And sum0 <= 5800 Then
      shui0 = sum0 * 0.15
      If shui0 >= 125 Then shui0 = 125
ElseIf sum0 > 5800 And sum0 <= 20800 Then
      shui0 = sum0 * 0.2
      If shui0 >= 375 Then shui0 = 375
End If

base0 = sum0 - Round(shui0, 2)

If base0 <= 400 Then
     fei0 = base0 * 0.005
ElseIf base0 > 400 And base0 <= 600 Then
     fei0 = base0 * 0.01
ElseIf base0 > 600 And base0 <= 800 Then
     fei0 = base0 * 0.015
ElseIf base0 > 800 And base0 <= 1500 Then
     fei0 = base0 * 0.02
ElseIf base0 > 1500 Then
     fei0 = base0 * 0.03
End If

Label17.Caption = Round(sum0, 2)
Label18.Caption = Round(shui0, 2)
Label19.Caption = Round(base0, 2)
Label20.Caption = Round(fei0, 2)

Command12.Enabled = True
End Sub

Private Sub Command14_Click()
If delflag = True Then
   MsgBox "己经执行过删除操作,为了防止数据库出错," & vbCrLf & "请重新查询,谢谢合作"
   Exit Sub
End If
If nowrecord = rec.RecordCount Then
   MsgBox "已经到了最后一条记录"
Else
   nowrecord = nowrecord + 1
   rec.MoveNext
   If rec.EOF Then Exit Sub
   Label16.Caption = "查询到记录" & rec.RecordCount & "条，现在第" & nowrecord & "条"
   Call display
End If
End Sub

Private Sub Command2_Click()
Call cleartext
End Sub

Private Sub Command7_Click()
If delflag = True Then
   MsgBox "己经执行过删除操作,为了防止数据库出错," & vbCrLf & "请重新查询,谢谢合作"
   Exit Sub
End If
If nowrecord = 1 Then
   MsgBox "已经到了第一条记录"
Else
   nowrecord = nowrecord - 1
   rec.MovePrevious
   If rec.BOF Then Exit Sub
   Label16.Caption = "查询到记录" & rec.RecordCount & "条，现在第" & nowrecord & "条"
   Call display
End If
End Sub

Private Sub Command8_Click()
If Trim(Text12.Text) = "" And Trim(Text13.Text) = "" Then
   MsgBox "请输入查询条件"
   Exit Sub
End If
If Trim(Text12.Text) <> "" And Trim(Text13.Text) <> "" Then
   sqlstr = "select * from teacher2003 where 工资号='" & Trim(CStr(Text12.Text)) & "' and 姓名='" & Trim(CStr(Text13.Text)) & "'"
ElseIf Trim(Text12.Text) = "" Then
   sqlstr = "select * from teacher2003 where 姓名='" & Trim(CStr(Text13.Text)) & "'"
ElseIf Trim(Text13.Text) = "" Then
   sqlstr = "select * from teacher2003 where 工资号='" & Trim(CStr(Text12.Text)) & "'"
End If

Set cnn = New ADODB.Connection
cnn.Open cnstr
Set rec = New ADODB.Recordset
rec.Open sqlstr, cnn, 3, 2
delflag = False
If rec.RecordCount >= 1 Then
   Label16.Caption = "查询到记录" & rec.RecordCount & "条，现在第" & nowrecord & "条"
   Call display
Else
   Label16.Caption = "  欢迎使用JsuFcz软件"
   MsgBox "没有要查询的记录"
End If
End Sub

Private Sub Command9_Click()
Form3.Show
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyF1 Then
     Form5.Show
  End If
End Sub

Private Sub Form_Load()
delflag = False
nowrecord = 1
Label16.Caption = "  欢迎使用JsuFcz软件"
Set cnn = New ADODB.Connection
cnn.Open cnstr
Set rec8 = New ADODB.Recordset
sqlstr = "select * from zongzhi"
rec8.Open sqlstr, cnn, 3, 1
If rec8.RecordCount >= 1 Then
   Do While Not rec8.EOF
      Combo1.AddItem rec8(0)
      rec8.MoveNext
   Loop
End If
rec8.Close
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub