?? payform.frm
字號:
VERSION 5.00
Begin VB.Form PayForm
Caption = "工資發放"
ClientHeight = 6795
ClientLeft = 60
ClientTop = 345
ClientWidth = 12975
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 6795
ScaleWidth = 12975
WindowState = 2 'Maximized
Begin VB.ComboBox cmbName
Height = 315
Left = 4680
TabIndex = 11
Top = 120
Width = 2535
End
Begin VB.CommandButton cmdGenerate
Caption = "生成月表"
Height = 495
Left = 10800
TabIndex = 9
Top = 960
Width = 1695
End
Begin VB.CommandButton cmdTest
Caption = "查詢是否已經發放"
Height = 495
Left = 10800
TabIndex = 8
Top = 1560
Width = 1695
End
Begin VB.ComboBox cmbMonth
Height = 315
Left = 8640
TabIndex = 7
Top = 120
Width = 1935
End
Begin VB.CommandButton cmdCancel
Caption = "取消"
Height = 495
Left = 10800
TabIndex = 5
Top = 3360
Width = 1695
End
Begin VB.CommandButton cmdPrint
Caption = "打印工資表"
Height = 495
Left = 10800
TabIndex = 4
Top = 2760
Width = 1695
End
Begin VB.CommandButton cmdPay
Caption = "發放工資"
Height = 495
Left = 10800
TabIndex = 3
Top = 2160
Width = 1695
End
Begin VB.ComboBox cmbEmployee
Height = 315
Left = 1320
TabIndex = 1
Top = 120
Visible = 0 'False
Width = 2175
End
Begin VB.Label Label3
Caption = "員工姓名"
Height = 255
Left = 3720
TabIndex = 10
Top = 120
Width = 975
End
Begin VB.Label label2
Caption = "月份"
Height = 255
Left = 7800
TabIndex = 6
Top = 120
Width = 615
End
Begin VB.OLE OLE1
Height = 5895
Left = 480
TabIndex = 2
Top = 720
Width = 9975
End
Begin VB.Label Label1
Caption = "員工ID"
Height = 255
Left = 120
TabIndex = 0
Top = 120
Visible = 0 'False
Width = 975
End
End
Attribute VB_Name = "PayForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'月表的名稱
'動態生成
'在cmbMonth中用戶可以填入2003-6, 2003-06, 2003-06-01等格式
'而月表的名稱都會變為200306
Public mTableName As String
'員工工資總額
'計算得到
Public mSum As Double
'當單擊cmbEmployee框,保證與cmbName的一致性
Private Sub cmbEmployee_Click()
cmbName.Text = cmbName.List(cmbEmployee.ListIndex)
cmbEmployee.Text = cmbEmployee.List(cmbEmployee.ListIndex)
End Sub
'當cmbMonth框發生改變,保證月表名稱一致
Private Sub cmbMonth_Change()
mTableName = Format(CDate(cmbMonth.Text), "YYYYMM")
cmbMonth.Text = mTableName
End Sub
'當單擊cmbEmployee框,保證與cmbName的一致性
Private Sub cmbName_Click()
cmbEmployee.Text = cmbEmployee.List(cmbName.ListIndex)
cmbName.Text = cmbName.List(cmbName.ListIndex)
End Sub
'退出窗體
Private Sub cmdCancel_Click()
Me.Hide
End Sub
'生成月表
'之所以使用On Error Resume Next
'是為了避免出現數據的不完整問題
Private Sub cmdGenerate_Click()
On Error Resume Next
'----------------------------------------------------
Dim SQL As String
'打開數據連接
OpenDBFile
'生成月表
mTableName = Format(CDate(cmbMonth.Text), "YYYYMM")
MakeUpTable
CloseDBFile
'初始化月表中的數據
SQL = "SELECT 職工ID FROM 職工"
OpenRS (SQL)
gRst.MoveFirst
While Not gRst.EOF
SQL = "INSERT INTO " & mTableName & "(職工ID, 工資取畢, 工資) VALUES(""" & gRst("職工ID") & """, NO, 0)"
gCon.Execute SQL
gRst.MoveNext
Wend
CloseRS
End Sub
'發放工資
Private Sub cmdPay_Click()
'打開錯誤處理陷阱
Dim intErrFileNo As Integer '自由文件號
On Error GoTo ErrGoto
'----------------------------------------------------
'打開數據連接
OpenDBFile
'執行修改數據庫
gCon.Execute "UPDATE " & mTableName & " SET 工資取畢=1, 工資=" & mSum & " WHERE 職工ID = """ & cmbEmployee.Text & """"
'顯示結果
MsgBox cmbEmployee.Text & "的工資已經發放完畢"
'關閉連接
CloseDBFile
'----------------------------------------------------
Exit Sub
'-----------------------------
ErrGoto:
'把錯誤信息保存在文件里
intErrFileNo = FreeFile()
Open "YFSystem.ini" For Append As intErrFileNo
Print #intErrFileNo, Chr(34) + Format(Now, "YYYY-MM-DD HH:MM:SS") + Chr(34), Chr(34) + "信息" + Chr(34), Chr(34) + Err.Description + Chr(34), Chr(34) + "cmdPay_Click(PayForm)" + Chr(34), Chr(34) + App.Title + Chr(34)
MsgBox "發放中出現錯誤:" & Err.Description
Close #intErrFileNo
End Sub
'打印報表
Private Sub cmdPrint_Click()
'打開錯誤處理陷阱
Dim intErrFileNo As Integer '自由文件號
On Error GoTo ErrGoto
'----------------------------------------------------
Dim sheet As Worksheet
Set sheet = gX.ActiveSheet
sheet.PrintOut
'----------------------------------------------------
Exit Sub
'-----------------------------
ErrGoto:
'把錯誤信息保存在文件里
intErrFileNo = FreeFile()
Open "YFSystem.ini" For Append As intErrFileNo
Print #intErrFileNo, Chr(34) + Format(Now, "YYYY-MM-DD HH:MM:SS") + Chr(34), Chr(34) + "信息" + Chr(34), Chr(34) + Err.Description + Chr(34), Chr(34) + "cmdPrint_Click(PayForm)" + Chr(34), Chr(34) + App.Title + Chr(34)
Print #intErrFileNo, Err.Description
Close #intErrFileNo
End Sub
'查詢并顯示本月工資
Private Sub cmdTest_Click()
'打開錯誤處理陷阱
Dim intErrFileNo As Integer '自由文件號
Dim sheet As Worksheet
Dim SQL As String, i As Integer
On Error GoTo ErrGoto
'----------------------------------------------------
If cmbEmployee.Text <> "" And cmbMonth.Text <> "" Then
'查詢工資領取情況
SQL = "select 工資取畢 from " & Format(CDate(cmbMonth.Text), "YYYYMM") & " where 職工ID = """ & cmbEmployee.Text & """"
'打開數據集
OpenRS (SQL)
gRst.MoveFirst
If gRst("工資取畢") = True Then
MsgBox "員工:" & cmbEmployee.Text & "已經取過" & cmbMonth.Text & "的工資"
Else
MsgBox "員工:" & cmbEmployee.Text & "還沒有取過" & cmbMonth.Text & "的工資"
End If
CloseRS
'職位相關的工資和今天
SQL = "SELECT * FROM 職工,職位 where 職工.職位 = 職位.職位 and 職工.職工ID = """ & cmbEmployee.Text & """"
OpenRS (SQL)
gRst.MoveFirst
'打開Excel對象,準備輸入信息
Set gX = GetObject("", "Excel.Application")
gX.Workbooks.Add
OLE1.Visible = True
'設置Worksheet對象
Set sheet = gX.ActiveSheet
'報表題目
sheet.Cells(1, 1) = cmbMonth.Text & "月工資表"
'職工的基本信息
sheet.Cells(2, 1) = "員工編號:"
sheet.Cells(2, 2) = cmbEmployee.Text
sheet.Cells(2, 3) = "員工職位:"
sheet.Cells(2, 4) = gRst("職工.職位")
sheet.Cells(2, 5) = "員工姓名:"
sheet.Cells(2, 6) = gRst("姓名")
'職工的一般工資信息
sheet.Cells(3, 1) = "基本工資"
sheet.Cells(3, 2) = gRst("基本工資")
sheet.Cells(3, 3) = "津貼"
sheet.Cells(3, 4) = gRst("津貼")
mSum = sheet.Cells(3, 2) + sheet.Cells(3, 4)
CloseRS
'搜索當月屬于該員工的特殊項
'每個月按30天算
SQL = "SELECT * FROM 特殊項 WHERE 職工ID = """ & cmbEmployee.Text & """ AND 特殊項日期 >= #" & cmbMonth.Text & "# and 特殊項日期 < #" & CStr(CDate(cmbMonth.Text) + 30) & "#"
OpenRS (SQL)
i = 3
If Not (gRst.BOF Or gRst.EOF) Then
gRst.MoveFirst
While Not gRst.EOF
i = i + 1
sheet.Cells(i, 1) = "特殊項名稱"
sheet.Cells(i, 2) = gRst("特殊項名稱")
sheet.Cells(i, 3) = "特殊項金額"
sheet.Cells(i, 4) = gRst("特殊項金額")
sheet.Cells(i, 5) = "特殊項日期"
sheet.Cells(i, 6) = CStr(gRst("特殊項日期"))
mSum = mSum + sheet.Cells(i, 4)
gRst.MoveNext
Wend
End If
i = i + 1
sheet.Cells(i, 1) = "工資總額"
sheet.Cells(i, 2) = mSum
CloseRS
'顯示格式設置
mTableName = Format(CDate(cmbMonth.Text), "YYYYMM")
sheet.Columns("A:F").ColumnWidth = 10
gX.ActiveWorkbook.SaveAs App.Path & "\" & cmbEmployee.Text & mTableName & ".xls"
OLE1.CreateLink App.Path & "\" & cmbEmployee.Text & mTableName & ".xls"
End If
'----------------------------------------------------
Exit Sub
'-----------------------------
ErrGoto:
'把錯誤信息保存在文件里
intErrFileNo = FreeFile()
Open App.Path & "\YFSystem.ini" For Append As intErrFileNo
Print #intErrFileNo, Chr(34) + Format(Now, "YYYY-MM-DD HH:MM:SS") + Chr(34), Chr(34) + "信息" + Chr(34), Chr(34) + Err.Description + Chr(34), Chr(34) + "cmdTest_Click(PayForm)" + Chr(34), Chr(34) + App.Title + Chr(34)
MsgBox Err.Description
Close #intErrFileNo
End Sub
'初始化窗體
Private Sub Form_Load()
gX.Visible = False
'打開錯誤處理陷阱
Dim intErrFileNo As Integer '自由文件號
On Error GoTo ErrGoto
'----------------------------------------------------
Dim SQL As String
'查找職工ID和姓名
SQL = "SELECT 職工ID,姓名 FROM 職工"
'打開數據集
OpenRS (SQL)
gRst.MoveFirst
cmbEmployee.Clear
cmbName.Clear
'添加數據到兩個ComboBox
While Not gRst.EOF
cmbEmployee.AddItem gRst("職工ID")
cmbName.AddItem gRst("姓名")
gRst.MoveNext
Wend
'關閉數據集
CloseRS
'查找已有的表名
SQL = "SELECT 月份 FROM 月份"
OpenRS (SQL)
cmbMonth.Clear
gRst.MoveFirst
'添加到cmbMonth組合框中
While Not gRst.EOF
cmbMonth.AddItem CStr(gRst("月份"))
gRst.MoveNext
Wend
'關閉數據集
CloseRS
'----------------------------------------------------
Exit Sub
'-----------------------------
ErrGoto:
'把錯誤信息保存在文件里
intErrFileNo = FreeFile()
Open App.Path & "\YFSystem.ini" For Append As intErrFileNo
Print #intErrFileNo, Chr(34) + Format(Now, "YYYY-MM-DD HH:MM:SS") + Chr(34), Chr(34) + "信息" + Chr(34), Chr(34) + Err.Description + Chr(34), Chr(34) + "Form_Load(PayForm)" + Chr(34), Chr(34) + App.Title + Chr(34)
Close #intErrFileNo
End Sub
'生成月表
'在使用該函數之前
'確認已經打開連接
'使用之后
'確認關閉連接
Sub MakeUpTable()
Dim SQL As String
On Error Resume Next
'儲存月表信息
SQL = "INSERT INTO 月份(表名,月份) VALUES( """ & mTableName & """, #" & cmbMonth.Text & "#)"
gCon.Execute SQL
'建立月表
SQL = "CREATE TABLE " & mTableName & "( 職工ID TEXT(50) PRIMARY KEY NOT NULL, 工資取畢 BIT NOT NULL, 工資 CURRENCY) "
gCon.Execute SQL
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -