📄 frmpay.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "Msflxgrd.ocx"
Begin VB.Form frmPay
Caption = "员工工资列表"
ClientHeight = 4455
ClientLeft = 60
ClientTop = 345
ClientWidth = 6705
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 4455
ScaleWidth = 6705
WindowState = 2 'Maximized
Begin MSFlexGridLib.MSFlexGrid msgList
Height = 3135
Left = 120
TabIndex = 1
Top = 480
Width = 6255
_ExtentX = 11033
_ExtentY = 5530
_Version = 393216
Cols = 4
FixedCols = 3
AllowUserResizing= 1
End
Begin VB.Label lblTitle
Caption = "员 工 工 资 列 表"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 255
Left = 240
TabIndex = 0
Top = 120
Width = 3135
End
End
Attribute VB_Name = "frmPay"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mrc As ADODB.Recordset
Dim MsgText As String
Public txtSQL As String
Dim mintRW As Integer
Public msBarText As String
Public reportName As String
Public reportSQL As String
Private Sub Form_Activate()
'设置读写权限
SetWorkRW mintRW
fMainForm.sbStatusBar.Panels(1).Text = msBarText
End Sub
Private Sub Form_Load()
'用户操作权限
Dim sPermission As String
Dim recTemp As Recordset
Dim sSql As String
Dim sByte As String
Dim MsgText As String
On Error GoTo myErr
'设置操作的表名称
'msTableName = "ampaytune"
'msRptName = "paytune.rpt"
'msOrderBy = " order by tzdate,tzid"
'sOrder0 = "+ {tzdate}"
'sOrder1 = "+ {tzid}"
'msSelect = "select * from "
'置mintRW初值
mintRW = 0
sSql = "select rw from permission where module=12 and id='" & sUserName & " '"
Set recTemp = ExecuteSQL(sSql, MsgText)
If recTemp.EOF = False Then
mintRW = CInt(recTemp!rw)
Else
mintRW = ERRORMODE
SetMdiEnv
MsgBox "您的帐号权限有错误！", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
reportName = "pay.rpt"
'设置msSql
'msSql = msSelect & msTableName & " where tzdate>='" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "' and tzdate<='" & Format(Now, "yyyy-mm-dd") & "'" & msOrderBy
'显示数据
msBarText = "当前数据时间范围：" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "至" & Format(Now, "yyyy-mm-dd")
flagEdit = True
ShowTitle
ShowData
Set recTemp = Nothing
Exit Sub
myErr:
ShowError
End Sub
Private Sub Form_Resize()
If Me.WindowState <> vbMinimized And fMainForm.WindowState <> vbMinimized Then
'边界处理
If Me.ScaleHeight < 10 * lblTitle.Height Then
Exit Sub
End If
If Me.ScaleWidth < lblTitle.Width + lblTitle.Width / 2 Then
Exit Sub
End If
'控制控件的位置
lblTitle.Top = lblTitle.Height
lblTitle.Left = (Me.Width - lblTitle.Width) / 2
msgList.Top = lblTitle.Top + lblTitle.Height + lblTitle.Height / 2
msgList.Width = Me.ScaleWidth - 200
msgList.Left = Me.ScaleLeft + 100
msgList.Height = Me.ScaleHeight - msgList.Top - 200
End If
End Sub
Public Sub FormClose()
Unload Me
End Sub
'删除记录
Public Sub RecordDelete()
Dim sSql As String
Dim intCount As Integer
Dim recTemp As ADODB.Recordset
Dim MsgText As String
On Error GoTo myErr
If msgList.Rows > 1 Then
If MsgBox("真的要删除这条文件记录么？", vbOKCancel + vbExclamation, "警告") = vbOK Then
intCount = msgList.Row
sSql = "delete from pay where gzid='" & Trim(msgList.TextMatrix(msgList.Row, 1)) & "' and gzdate= '" & Format(msgList.TextMatrix(msgList.Row, 16), "yyyy-mm-dd") & "'"
Set recTemp = ExecuteSQL(sSql, MsgText)
ShowData
End If
End If
Exit Sub
myErr:
ShowError
End Sub
Public Sub RecordEdit()
Dim intCount As Integer
If flagEdit Then
gintMode = 2
If frmPay.msgList.Rows > 1 Then
intCount = frmPay.msgList.Row
frmPay1.txtSQL = "select * from pay where gzid='" & Trim(frmPay.msgList.TextMatrix(frmPay.msgList.Row, 1)) & "' and gzdate='" & Format(frmPay.msgList.TextMatrix(intCount, 16), "yyyy-mm-dd") & "'"
frmPay1.Show
Else
Call RecordAdd
End If
Else
MsgBox "请选择要修改的记录？", vbOKOnly + vbExclamation, "警告"
frmPay.txtSQL = "select * from pay"
frmPay.Show
frmPay.ZOrder 0
End If
End Sub
'刷新表格
Public Sub RecordRefresh()
ShowData
End Sub
'记录添加
Public Sub RecordAdd()
gintMode = 1
frmPay1.Show
frmPay1.ZOrder 0
End Sub
'记录查询
Public Sub RecordFind()
frmPay2.Show 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
flagEdit = False
gintMode = 0
SetMdiEnv
End Sub
'详细显示记录
Public Sub RecordView()
If msgList.Rows > 1 = False Then
gintMode = VIEW
gsSql = " where gzid='" & Trim(msgList.TextMatrix(msgList.Row, 1)) & "' and gzdate=cdate('" & Format(msgList.TextMatrix(msgList.Row, 16), "yyyy-mm-dd") & "')"
frmPay1.Show 1
End If
End Sub
'计发本月工资
Public Sub WageOut()
frmWage.Show 1
End Sub
'计发基本工资
Public Sub WageOne()
Dim sSql As String
On Error GoTo myErr
With fMainForm
'设置菜单和工具条
.mnuFile.Enabled = False
.mnuRecord.Enabled = False
.mnuMan.Enabled = False
.mnuBonus.Enabled = False
.mnuCar.Enabled = False
.mnuMater.Enabled = False
.mnuWork.Enabled = False
.mnuWindow.Enabled = False
.mnuSysEdit.Enabled = False
.mnuPreview.Enabled = False
.mnuPrint.Enabled = False
.mnuWage.Enabled = False
.tbToolBar.Enabled = False
End With
With fMainForm.crptPrint
'设定连接串
.Connect = gsCon
'设定打印的报表文件
.ReportFileName = App.Path & "\rpt\one.rpt"
'排序
.SortFields(0) = sOrder0
.SortFields(1) = sOrder1
'指定打印的记录数
sSql = msSql
.SQLQuery = Left(sSql, InStr(1, sSql, "order by") - 2)
.PrinterStartPage = 0
.PrinterStopPage = -1
.CopiesToPrinter = 1
'设定打印预览窗口为frmPreview的子窗体
.WindowParentHandle = frmPreview.hWnd
frmPreview.Show
'设定打印的方式
.Destination = PREVIEWMODE
.Action = PREVIEWMODE
End With
myErr:
ShowError
End Sub
'计发基本工资
Public Sub WageTwo()
Dim sSql As String
On Error GoTo myErr
With fMainForm
'设置菜单和工具条
.mnuFile.Enabled = False
.mnuRecord.Enabled = False
.mnuMan.Enabled = False
.mnuBonus.Enabled = False
.mnuCar.Enabled = False
.mnuMater.Enabled = False
.mnuWork.Enabled = False
.mnuWindow.Enabled = False
.mnuSysEdit.Enabled = False
.mnuPreview.Enabled = False
.mnuPrint.Enabled = False
.mnuWage.Enabled = False
.tbToolBar.Enabled = False
End With
With fMainForm.crptPrint
'设定连接串
.Connect = gsCon
'设定打印的报表文件
.ReportFileName = App.Path & "\rpt\two.rpt"
'排序
.SortFields(0) = sOrder0
.SortFields(1) = sOrder1
'指定打印的记录数
sSql = msSql
.SQLQuery = Left(sSql, InStr(1, sSql, "order by") - 2)
.PrinterStartPage = 0
.PrinterStopPage = -1
.CopiesToPrinter = 1
'设定打印预览窗口为frmPreview的子窗体
.WindowParentHandle = frmPreview.hWnd
frmPreview.Show
'设定打印的方式
.Destination = PREVIEWMODE
.Action = PREVIEWMODE
End With
Exit Sub
myErr:
ShowError
End Sub
'显示Grid的内容
Public Sub ShowData()
Dim j As Integer
Dim i As Integer
Set mrc = ExecuteSQL(txtSQL, MsgText)
With msgList
.Rows = 1
Do While Not mrc.EOF
.Rows = .Rows + 1
For i = 1 To mrc.Fields.Count
Select Case mrc.Fields(i - 1).Type
Case adDBDate
.TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i - 1) & "", "yyyy-mm-dd")
Case Else
.TextMatrix(.Rows - 1, i) = mrc.Fields(i - 1) & ""
End Select
Next i
mrc.MoveNext
Loop
End With
mrc.Close
End Sub
'显示Grid表头
Public Sub ShowTitle()
Dim i As Integer
With msgList
.Cols = 17
.TextMatrix(0, 1) = "编号"
.TextMatrix(0, 2) = "姓名"
.TextMatrix(0, 3) = "底薪"
.TextMatrix(0, 4) = "补贴"
.TextMatrix(0, 5) = "奖金"
.TextMatrix(0, 6) = "加班"
.TextMatrix(0, 7) = "扣考核"
.TextMatrix(0, 8) = "代扣养老金"
.TextMatrix(0, 9) = "代扣医疗保险"
.TextMatrix(0, 10) = "代扣住房公积金"
.TextMatrix(0, 11) = "税前小计"
.TextMatrix(0, 12) = "所得税"
.TextMatrix(0, 13) = "房贴"
.TextMatrix(0, 14) = "房租"
.TextMatrix(0, 15) = "实发工资"
.TextMatrix(0, 16) = "时间"
'固定表头
.FixedRows = 1
'设置各列的对齐方式
For i = 0 To 1
.ColAlignment(i) = 0
Next i
For i = 2 To 15
.ColAlignment(i) = 7
Next i
.ColAlignment(16) = 0
'表头项居中
.FillStyle = flexFillRepeat
.Col = 0
.Row = 0
.RowSel = 1
.ColSel = .Cols - 1
.CellAlignment = 4
'设置单元大小
.ColWidth(0) = 300
For i = 1 To 6
.ColWidth(i) = 1000
Next i
.ColWidth(7) = 1200
.ColWidth(8) = 1200
.ColWidth(9) = 1400
For i = 10 To 16
.ColWidth(i) = 1000
Next i
.Row = 1
End With
End Sub
Private Sub msgList_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'右键弹出
If Button = 2 And Shift = 0 Then
PopupMenu fMainForm.menuPay
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -