📄 frmmonthpayment.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{00025600-0000-0000-C000-000000000046}#4.6#0"; "CRYSTL32.OCX"
Begin VB.Form frmMonthPayment
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "月末结算"
ClientHeight = 4485
ClientLeft = 45
ClientTop = 330
ClientWidth = 6405
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4485
ScaleWidth = 6405
StartUpPosition = 2 '屏幕中心
Begin Crystal.CrystalReport CrystalReport1
Left = 300
Top = 4050
_ExtentX = 741
_ExtentY = 741
_Version = 262150
ReportFileName = "C:\SYSTEM\REPORT\ygyj.rpt"
WindowWidth = 800
WindowHeight = 600
WindowControlBox= -1 'True
WindowMaxButton = -1 'True
WindowMinButton = -1 'True
WindowState = 2
End
Begin VB.CommandButton cmdCancel
BackColor = &H00C0C0C0&
Caption = "取 消"
Height = 375
Left = 3825
Style = 1 'Graphical
TabIndex = 8
Top = 3915
Width = 855
End
Begin VB.CommandButton cmdOk
BackColor = &H00C0C0C0&
Caption = "确 定"
Height = 375
Left = 1665
Style = 1 'Graphical
TabIndex = 7
Top = 3915
Width = 855
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 255
Left = 4665
TabIndex = 5
Top = 720
Width = 1335
_ExtentX = 2355
_ExtentY = 450
_Version = 393216
Format = 24576001
CurrentDate = 36746
End
Begin VB.Frame Frame1
BackColor = &H00C0C0C0&
Caption = "结算"
ForeColor = &H00FF0000&
Height = 2775
Left = 345
TabIndex = 1
Top = 960
Width = 5655
Begin VB.Frame Frame2
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 520
Left = 225
TabIndex = 9
Top = 2025
Width = 5190
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 180
Left = 75
Negotiate = -1 'True
TabIndex = 10
Top = 240
Width = 5055
_ExtentX = 8916
_ExtentY = 318
_Version = 393216
BorderStyle = 1
Appearance = 1
End
End
Begin VB.CheckBox chkShowReport
BackColor = &H00C0C0C0&
Caption = "结算后显示详细报表"
ForeColor = &H00FF0000&
Height = 255
Left = 600
TabIndex = 3
Top = 840
Width = 1935
End
Begin VB.CheckBox chkBackup
BackColor = &H00C0C0C0&
Caption = "结算前首先备份数据"
ForeColor = &H00FF0000&
Height = 255
Left = 600
TabIndex = 2
Top = 360
Width = 1935
End
Begin VB.Label Label4
Caption = "正在结算请稍候。。。。。。"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 315
Left = 450
TabIndex = 12
Top = 1725
Width = 3315
End
Begin VB.Label Label3
Caption = "注意事项：每月只能结算一次，否则数据发生错误！"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 315
Left = 450
TabIndex = 11
Top = 1425
Width = 4890
End
Begin VB.Label Label2
BackColor = &H00C0C0C0&
Caption = "建议结算前备份数据"
ForeColor = &H000000FF&
Height = 255
Left = 3360
TabIndex = 4
Top = 375
Width = 1695
End
End
Begin VB.Label Label5
BackColor = &H00C0C0C0&
Caption = "结算日期"
ForeColor = &H00FF0000&
Height = 255
Left = 3825
TabIndex = 6
Top = 780
Width = 735
End
Begin VB.Label Label1
BackColor = &H00C0C0C0&
Caption = "月末结算"
BeginProperty Font
Name = "宋体"
Size = 21.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 480
Left = 2340
TabIndex = 0
Top = 165
Width = 1815
End
End
Attribute VB_Name = "frmMonthPayment"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1
Dim Conn购货清单 As New ADODB.Connection
Dim rs购货清单 As New ADODB.Recordset
Dim rs产品统计 As New ADODB.Recordset
Dim rs公司代号 As New ADODB.Recordset
Dim Conn员工资料 As New ADODB.Connection
Dim rs员工资料 As New ADODB.Recordset
Dim rs担保人 As New ADODB.Recordset
Dim cmdBackup As New ADODB.Command
Dim varJXJxishu
Dim StartYear, StartMonth, StartDay, StartPaymentDay
Dim EndYear, EndMonth, EndDay, EndPaymentDay
Dim ALevel As Integer, ASubtree As Integer
Dim Total As Long
Dim Sql As String
Dim EmployeeInfoSQL As String '员工资料SQL语句
Dim RecognizorInfoSQL As String '担保人SQL语句
Dim HeresInfoSQL As String '被担保人SQL语句（下级）
Public Function countCLJT(ALevel As Integer, ASubtree As Integer, Total As Long)
Select Case ASubtree
Case 0
countCLJT = Total * 67 / 350
Case 1
If ALevel > 3 Then
countCLJT = 0
Exit Function
End If
countCLJT = Total * xishuCLJT(ALevel)
Case 2
If ALevel > 5 Then
countCLJT = 0
Exit Function
End If
countCLJT = Total * xishuCLJT(ALevel)
Case 3
If ALevel > 7 Then
countCLJT = 0
Exit Function
End If
countCLJT = Total * xishuCLJT(ALevel)
Case 4
If ALevel > 9 Then
countCLJT = 0
Exit Function
End If
countCLJT = Total * xishuCLJT(ALevel)
Case Else
countCLJT = 0
End Select
End Function
Public Function xishuCLJT(ALevel As Integer)
Select Case ALevel
Case 1
xishuCLJT = 67 / 350
Case 2
xishuCLJT = 25 / 350
Case 3
xishuCLJT = 18 / 350
Case 4
xishuCLJT = 9 / 350
Case 5
xishuCLJT = 5 / 350
Case 6
xishuCLJT = 4 / 350
Case 7
xishuCLJT = 3 / 350
Case 8
xishuCLJT = 2 / 350
Case 9
xishuCLJT = 1 / 350
Case 10
xishuCLJT = 1 / 350
Case Else
xishuCLJT = 0
End Select
End Function
Function TaxRate(Tax As Single)
Select Case True
Case Tax < 800
TaxRate = 0
Case Tax >= 800 And Tax < 2000
TaxRate = 0.058
Case Tax >= 2000 And Tax < 5000
TaxRate = 0.07
Case Tax >= 5000 And Tax < 10000
TaxRate = 0.083
Case Tax >= 10000 And Tax < 20000
TaxRate = 0.156
Case Tax >= 20000 And Tax < 40000
TaxRate = 0.184
Case Tax >= 40000 And Tax < 60000
TaxRate = 0.211
Case Tax >= 60000 And Tax < 80000
TaxRate = 0.24
Case Tax >= 80000 And Tax < 100000
TaxRate = 0.272
Case Tax >= 100000 And Tax < 300000
TaxRate = 0.3
Case Tax >= 300000
TaxRate = 0.36
End Select
End Function
Private Sub cmdCancel_Click()
'ConnBackup.Close
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim ConnBackupStr As String
Dim cmdSQL As String
Dim RecognizorNo As String
Dim EmployeeNo As String
Dim EmployeeName As String
Dim EmployeeLevel As String
Dim DirectSale As Boolean '定义是否直接销售
Dim EmployeeJXJxishu As Integer '定义员工绩效奖系数
Dim RecognizorJXJxishu As Integer '定义担保人绩效奖系数
Static Blevel As Integer
Static Bjintie As Single
Dim Tax As Single
Dim Income As String
Dim ProductSql As String
'Dim JSEmployeeInfoSQL As String
' ***************************************************************************************** '
' '
' 备 份 数 据 '
' '
' ***************************************************************************************** '
Label3.Visible = False
If chkBackup.Value = 1 Then
frmDataBackup.Show 1
End If
MsgBox "开始结算！"
Label3.Visible = False
Label4.Visible = True
Frame2.Visible = True
ProgressBar1.Min = 0
ProgressBar1.Max = rs购货清单.RecordCount
' ***************************************************************************************** '
' '
' 在产品统计表里增加员工、公司记录 '
' '
' ***************************************************************************************** '
EmployeeInfoSQL = "select * from 员工资料"
rs员工资料.Open EmployeeInfoSQL, Conn员工资料, adOpenKeyset, adLockPessimistic
rs员工资料.MoveFirst
Do While Not rs员工资料.EOF
rs公司代号.MoveFirst
Do While Not rs公司代号.EOF
If rs产品统计.State = adStateOpen Then
rs产品统计.Close
End If
EmployeeInfoSQL = "select * from 产品统计 order by 工号"
rs产品统计.Open EmployeeInfoSQL, Conn员工资料, adOpenKeyset, adLockPessimistic
rs产品统计.AddNew
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -