form1.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "欢迎使用"
   ClientHeight    =   1245
   ClientLeft      =   3795
   ClientTop       =   3780
   ClientWidth     =   5655
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "Form1.frx":000C
   ScaleHeight     =   1245
   ScaleWidth      =   5655
   Begin VB.Timer Timer1 
      Interval        =   3000
      Left            =   480
      Top             =   240
   End
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   1680
      Top             =   240
   End
   Begin VB.Timer Timer3 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   1080
      Top             =   240
   End
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   135
      Left            =   240
      TabIndex        =   0
      Top             =   840
      Visible         =   0   'False
      Width           =   2895
      _ExtentX        =   5106
      _ExtentY        =   238
      _Version        =   393216
      Appearance      =   1
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim wx, wy, nowvalue As Integer
Dim sum0, shui0, base0, fei0 As Double
Dim again1 As Boolean
Dim again2 As Boolean

Private Sub Form_Load()
again1 = False
again2 = False
wx = Me.Width
wy = Me.Height
sum0 = 0
shui0 = 0
base0 = 0
fei0 = 0
nowvalue = 0
Set fso = CreateObject("scripting.filesystemobject")
If Not fso.FileExists(App.Path & "\dangfei.mdb") Then
   Timer1.Enabled = False
   MsgBox "在安装目录下没有发现数据库文件" & vbCrLf & "请将文件dangfei.mdb拷贝到此目录中"
   End
End If
End Sub

Private Sub Form_Resize()
Me.Width = wx
Me.Height = wy
End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
Timer2.Enabled = True

cnstr = "driver={Microsoft Access Driver (*.mdb)};dbq=" & App.Path & "\dangfei.mdb;uid=;pwd="
Set cnn = New ADODB.Connection
cnn.Open cnstr
Set rec = New ADODB.Recordset
sqlstr = "select * from teacher2003 order by 工作部门"
rec.Open sqlstr, cnn, 3, 2

ProgressBar1.Max = rec.RecordCount
If rec.RecordCount >= 1 Then
here:
   Do While Not rec.EOF
   If IsNull(rec(0)) Then
      If again1 = False Then
         answer1 = MsgBox("发现没有工资号的记录，要删除吗？", 4)
         again1 = True
      End If
      If answer1 = 1 Then
         rec.Delete
         rec.Update
         rec.MoveNext
         GoTo here
      Else
         rec(0) = "暂无记录"
         rec.Update
      End If
   End If
   If IsNull(rec(1)) Then
      rec(1) = "暂无记录"
      rec.Update
   End If
   If IsNull(rec(2)) Then
      If again2 = False Then
          answer2 = MsgBox("发现没有姓名的记录，要删除吗？", 4)
          again2 = True
      End If
      If answer2 = 1 Then
         rec.Delete
         rec.Update
         rec.MoveNext
         GoTo here
      Else
         rec(2) = "暂无记录"
         rec.Update
      End If
   End If
   
   For i = 3 To 10
       If IsNull(rec(i)) Then rec(i) = 0
   Next
   For i = 11 To 12
       If IsNull(rec(i)) Then rec(i) = "暂无记录"
   Next
   For i = 13 To 24
       If IsNull(rec(i)) Then rec(i) = "未交"
   Next
   rec.Update
   
   sum0 = rec(4) + rec(5) + rec(6) + rec(7)
   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

    rec(3) = Round(fei0, 2)
    rec(8) = Round(sum0, 2)
    rec(9) = Round(shui0, 2)
    rec(10) = Round(base0, 2)
    rec.Update
    nowvalue = nowvalue + 1
    rec.MoveNext
   Loop
   rec.Close
End If
End Sub

Private Sub Timer2_Timer()
ProgressBar1.Value = nowvalue
If ProgressBar1.Value = ProgressBar1.Max Then
   Timer2.Enabled = False
   Timer3.Enabled = True
End If
End Sub

Private Sub Timer3_Timer()
   Timer3.Enabled = False
   Me.Hide
   Form2.Show
End Sub