VERSION 5.00
Begin VB.Form ThisMonthSalaryForm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "當月工資細表"
   ClientHeight    =   8115
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   11280
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   8115
   ScaleWidth      =   11280
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   495
      Left            =   9360
      TabIndex        =   3
      Top             =   1680
      Width           =   1455
   End
   Begin VB.CommandButton cmdGenerate 
      Caption         =   "生成報表"
      Height          =   495
      Left            =   9360
      TabIndex        =   2
      Top             =   240
      Width           =   1455
   End
   Begin VB.CommandButton cmdPrint 
      Caption         =   "打印報表"
      Height          =   495
      Left            =   9360
      TabIndex        =   1
      Top             =   960
      Width           =   1455
   End
   Begin VB.OLE OLE1 
      AutoActivate    =   0  'Manual
      Height          =   7695
      Left            =   240
      SizeMode        =   2  'AutoSize
      TabIndex        =   0
      Top             =   120
      UpdateOptions   =   1  'Frozen
      Width           =   9015
   End
End
Attribute VB_Name = "ThisMonthSalaryForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'月表的名字
Dim mMonth As String

'Excel報表的行數
Dim mIndex As Integer

'職工ID, SQL語句, 職工統計工資
Dim mEIDs() As String, SQL As String, mSum() As Double

'Excel報表對象
Dim mSheet As Worksheet

'如有必要取消報表生成
Dim mCancelGenerate As Boolean

Private Sub cmdCancel_Click()
    Me.Hide
End Sub

'生成報表
Private Sub cmdGenerate_Click()
    '打開錯誤處理陷阱
    Dim intErrFileNo As Integer  '自由文件號
    Set gX = GetObject("", "Excel.Application")
    On Error GoTo ErrGoto
    '----------------------------------------------------
    mCancelGenerate = False
    
    '生成職工ID數組
    SQL = "SELECT 職工ID FROM 職工"
    OpenRS (SQL)
    gRst.MoveFirst
    Dim counts As Integer
    gRst.MoveLast
    counts = gRst.RecordCount
    gRst.MoveFirst
    ReDim mEIDs(counts)
    ReDim mSum(counts)
    Dim i As Integer
    i = 0
    While Not gRst.EOF
        i = i + 1
        mEIDs(i) = gRst("職工ID")
        gRst.MoveNext
    Wend
    CloseRS
    
    '新建Excel表格
    gX.Workbooks.Close
    gX.Workbooks.Add
    gX.Visible = True
    Set mSheet = gX.ActiveSheet
    
    '寫入細表
    mIndex = 0
    mIndex = mIndex + 1
    mSheet.Cells(mIndex, 1) = mMonth & "細表"
    For i = 1 To counts
        If Not mCancelGenerate Then
            '寫入單個職工信息
            writeXL mEIDs(i), i
            mIndex = mIndex + 1
        End If
    Next
    
    '設置顯示格式
    mSheet.Columns("A:F").ColumnWidth = 10
    
    '存儲文檔
    gX.ActiveWorkbook.SaveAs App.Path & "\" & mMonth & "細表.xls"
    
    'OLE顯示
    OLE1.CreateLink App.Path & "\" & mMonth & "細表.xls"
    '----------------------------------------------------
    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) + "cmdGenerate_Click(ThisMonthSalaryForm)" + Chr(34), Chr(34) + App.Title + Chr(34)
    Close #intErrFileNo
End Sub

Private Sub cmdPrint_Click()
    On Error Resume Next
    gX.Workbooks.Open App.Path & "\" & mMonth & "細表.xls"
    Set mSheet = gX.ActiveSheet
    mSheet.PrintOut
    gX.Workbooks.Close
End Sub

Private Sub Form_Load()
    mMonth = Format(Date - 30, "YYYYMM")
    mIndex = 0
    mCancelGenerate = False
End Sub

'寫入單個職工信息
Private Sub writeXL(EID As String, index As Integer)
    '打開錯誤處理陷阱
    Dim intErrFileNo As Integer  '自由文件號
    On Error GoTo ErrGoto
    '----------------------------------------------------
    mIndex = mIndex + 1
    SQL = "select 工資取畢 from " & mMonth & " where 職工ID = """ & EID & """"
    OpenRS (SQL)
    '用戶不存在,則報錯,取消生成
    If gRst.BOF Or gRst.EOF Then
        CloseRS
        MsgBox "請先到工資發放窗體生成當前月的月表!"
        mCancelGenerate = True
    Else
        gRst.MoveFirst
        '顯示工資領取信息
        If gRst("工資取畢") = True Then
            mSheet.Cells(mIndex, 1) = "工資取畢"
            mSheet.Cells(mIndex, 2) = "是"
            CloseRS
        Else
            mSheet.Cells(mIndex, 1) = "工資取畢"
            mSheet.Cells(mIndex, 2) = "否"
            CloseRS
        End If
        
        '職位工資
        SQL = "SELECT * FROM 職工,職位 where 職工.職位 = 職位.職位 and 職工.職工ID = """ & EID & """"
        OpenRS (SQL)
        gRst.MoveFirst
        OLE1.Visible = True
            
        '職工信息
        mIndex = mIndex + 1
        mSheet.Cells(mIndex, 1) = "員工編號:"
        mSheet.Cells(mIndex, 2) = EID
        mSheet.Cells(mIndex, 3) = "員工職位:"
        mSheet.Cells(mIndex, 4) = gRst("職工.職位")
        mSheet.Cells(mIndex, 5) = "員工姓名:"
        mSheet.Cells(mIndex, 6) = gRst("姓名")
        
        '職位工資信息
        mIndex = mIndex + 1
        mSheet.Cells(mIndex, 1) = "基本工資"
        mSheet.Cells(mIndex, 2) = gRst("基本工資")
        mSheet.Cells(mIndex, 3) = "津貼"
        mSheet.Cells(mIndex, 4) = gRst("津貼")
        mSum(index) = mSheet.Cells(mIndex, 2) + mSheet.Cells(mIndex, 4)
        CloseRS
        
        '搜索當月屬于該員工的特殊項
        '每個月按30天算
        SQL = "SELECT * FROM 特殊項 WHERE 職工ID = """ & EID & """ AND 特殊項日期 >= #" & Format(Date - 30, "YYYY-MM") & "# and 特殊項日期 < #" & Format(Date, "YYYY-MM") & "#"
        OpenRS (SQL)
        
    
        If Not (gRst.BOF Or gRst.EOF) Then
            gRst.MoveFirst
            While Not gRst.EOF
                '特殊項信息
                mIndex = mIndex + 1
                mSheet.Cells(mIndex, 1) = "特殊項名稱"
                mSheet.Cells(mIndex, 2) = gRst("特殊項名稱")
                mSheet.Cells(mIndex, 3) = "特殊項金額"
                mSheet.Cells(mIndex, 4) = gRst("特殊項金額")
                mSheet.Cells(mIndex, 5) = "特殊項日期"
                mSheet.Cells(mIndex, 6) = gRst("特殊項日期")
                mSum(index) = mSum(index) + mSheet.Cells(mIndex, 4)
                gRst.MoveNext
            Wend
        End If
        mIndex = mIndex + 1
        '工資總額
        mSheet.Cells(mIndex, 1) = "工資總額"
        mSheet.Cells(mIndex, 2) = mSum(index)
        gCon.Execute "Update " & mMonth & " SET 工資= " & mSum(index) & " WHERE 職工ID = """ & EID & """"
        CloseRS
    End If
    '----------------------------------------------------
    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) + "writeXL(ThisMonthSalaryForm)" + Chr(34), Chr(34) + App.Title + Chr(34)
    Close #intErrFileNo
End Sub