?? payform.frm

?? 人事管理系統(tǒng) 連接access數(shù)據(jù)庫還可以生成xls文件
?? FRM
字號:
VERSION 5.00
Begin VB.Form PayForm 
   Caption         =   "工資發(fā)放"
   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         =   "查詢是否已經(jīng)發(fā)放"
      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         =   "發(fā)放工資"
      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
'月表的名稱
'動態(tài)生成
'在cmbMonth中用戶可以填入2003-6, 2003-06, 2003-06-01等格式
'而月表的名稱都會變?yōu)?00306
Public mTableName As String
'員工工資總額
'計算得到
Public mSum As Double

'當(dāng)單擊cmbEmployee框,保證與cmbName的一致性
Private Sub cmbEmployee_Click()
    cmbName.Text = cmbName.List(cmbEmployee.ListIndex)
    cmbEmployee.Text = cmbEmployee.List(cmbEmployee.ListIndex)
End Sub

'當(dāng)cmbMonth框發(fā)生改變,保證月表名稱一致
Private Sub cmbMonth_Change()
    mTableName = Format(CDate(cmbMonth.Text), "YYYYMM")
    cmbMonth.Text = mTableName
End Sub

'當(dāng)單擊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
'是為了避免出現(xiàn)數(shù)據(jù)的不完整問題
Private Sub cmdGenerate_Click()
    On Error Resume Next
    '----------------------------------------------------
    Dim SQL As String
    
    '打開數(shù)據(jù)連接
    OpenDBFile
    '生成月表
    mTableName = Format(CDate(cmbMonth.Text), "YYYYMM")
    MakeUpTable
    CloseDBFile
    
    '初始化月表中的數(shù)據(jù)
    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

'發(fā)放工資
Private Sub cmdPay_Click()
    '打開錯誤處理陷阱
    Dim intErrFileNo As Integer  '自由文件號
    On Error GoTo ErrGoto
    '----------------------------------------------------
    '打開數(shù)據(jù)連接
    OpenDBFile
    '執(zhí)行修改數(shù)據(jù)庫
    gCon.Execute "UPDATE " & mTableName & " SET 工資取畢=1, 工資=" & mSum & " WHERE 職工ID = """ & cmbEmployee.Text & """"
    '顯示結(jié)果
    MsgBox cmbEmployee.Text & "的工資已經(jīng)發(fā)放完畢"
    '關(guān)閉連接
    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 "發(fā)放中出現(xiàn)錯誤:" & 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
        '查詢工資領(lǐng)取情況
        SQL = "select 工資取畢 from " & Format(CDate(cmbMonth.Text), "YYYYMM") & " where 職工ID = """ & cmbEmployee.Text & """"
        '打開數(shù)據(jù)集
        OpenRS (SQL)
        gRst.MoveFirst
        If gRst("工資取畢") = True Then
            MsgBox "員工:" & cmbEmployee.Text & "已經(jīng)取過" & cmbMonth.Text & "的工資"
        Else
            MsgBox "員工:" & cmbEmployee.Text & "還沒有取過" & cmbMonth.Text & "的工資"
        End If
        CloseRS
        
        '職位相關(guān)的工資和今天
        SQL = "SELECT * FROM 職工,職位 where 職工.職位 = 職位.職位 and 職工.職工ID = """ & cmbEmployee.Text & """"
        OpenRS (SQL)
        gRst.MoveFirst
        
        '打開Excel對象,準(zhǔn)備輸入信息
        Set gX = GetObject("", "Excel.Application")
        gX.Workbooks.Add
        OLE1.Visible = True
        
        '設(shè)置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
        
        '搜索當(dāng)月屬于該員工的特殊項
        '每個月按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
        '顯示格式設(shè)置
        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 職工"
    
    '打開數(shù)據(jù)集
    OpenRS (SQL)
    
    gRst.MoveFirst
    cmbEmployee.Clear
    cmbName.Clear
    '添加數(shù)據(jù)到兩個ComboBox
    While Not gRst.EOF
        cmbEmployee.AddItem gRst("職工ID")
        cmbName.AddItem gRst("姓名")
        gRst.MoveNext
    Wend
    
    '關(guān)閉數(shù)據(jù)集
    CloseRS
    
    '查找已有的表名
    SQL = "SELECT 月份 FROM 月份"
    OpenRS (SQL)
    cmbMonth.Clear
    gRst.MoveFirst
    
    '添加到cmbMonth組合框中
    While Not gRst.EOF
        cmbMonth.AddItem CStr(gRst("月份"))
        gRst.MoveNext
    Wend
    
    '關(guān)閉數(shù)據(jù)集
    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

'生成月表
'在使用該函數(shù)之前
'確認(rèn)已經(jīng)打開連接
'使用之后
'確認(rèn)關(guān)閉連接
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
?? 文件大小 58 K
?? 上傳用戶 zhoubin2048
?? 所屬分類壓縮解壓
??? 相關(guān)標(biāo)簽

#access #xls #管理系統(tǒng) #數(shù)據(jù)庫
?? 快捷鍵說明

復(fù)制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? payform.frm

?? 快捷鍵說明
