modexport.bas

工资发放条输出程序

Attribute VB_Name = "modExport"
Option Explicit

'参照参数
Global gvarType         As Variant      '工资类别
Global gvarDept         As Variant      '部门
Global gvarItem         As Variant      '工资项目
Global gvarItemTitle    As Variant      '工资条项目标题

Global gobjExcel        As Object       'Excel对象

Dim rstTemp             As Recordset    '临时记录集

'------------------------------------------------------------
'获得工资类别参数
'------------------------------------------------------------
Sub GetRowsType()
    On Error GoTo GetRowsErr
    
    Dim rstTemp As Recordset
    Dim strSQL As String
    Dim lngRecCount As Long
    
    '数据来源 - WA_account(工资类别设置表)
    strSQL = "SELECT cGZGradeNum,cGZGradename FROM WA_account;"

    Set rstTemp = gdbCurrentDB.OpenRecordset(strSQL)
    
    '根据记录数装载参数到数组中
    With rstTemp
        If Not .EOF Then
            .MoveLast
            lngRecCount = .RecordCount
            .MoveFirst
            gvarType = rstTemp.GetRows(lngRecCount)
        End If
    End With
    
    rstTemp.Close
    
    Set rstTemp = Nothing
    Exit Sub
    
GetRowsErr:
    If Not rstTemp Is Nothing Then Set rstTemp = Nothing
    MsgBox Err.Description, vbCritical + vbOKOnly, "错误"
    
    
End Sub

'------------------------------------------------------------
'获得部门参数
'------------------------------------------------------------
Sub GetRowsDept(TypeID As String)
    On Error GoTo GetRowsErr
    
    Dim rstTemp As Recordset
    Dim strSQL As String
    Dim lngRecCount As Long
    
    '数据来源 - Department(部门档案) 和 WA_dept(工资类别部门表)
    strSQL = "SELECT Department.cDepCode, Department.cDepName " & _
           "FROM Department INNER JOIN WA_dept ON Department.cDepCode = WA_dept.cDept_Num " & _
           "WHERE (((WA_dept.cGZGradeNum)='" & TypeID & "') AND ((Department.bDepEnd)=True));"

    
    Set rstTemp = gdbCurrentDB.OpenRecordset(strSQL)
    
    '根据记录数装载参数到数组中
    With rstTemp
        If Not .EOF Then
            .MoveLast
            lngRecCount = .RecordCount
            .MoveFirst
            gvarDept = rstTemp.GetRows(lngRecCount)
        End If
    End With
        
        
    rstTemp.Close
    
    Set rstTemp = Nothing
    Exit Sub
    
GetRowsErr:
    If Not rstTemp Is Nothing Then Set rstTemp = Nothing
    MsgBox Err.Description, vbCritical + vbOKOnly, "错误"
    
    
End Sub

'------------------------------------------------------------
'获得工资项目标题参数
'------------------------------------------------------------
Sub GetRowsItemTitle(strType As String)
    On Error GoTo GetRowsErr
    
    Dim rstTemp As Recordset
    Dim strSQL As String
    Dim lngRecCount As Long
    
    '数据来源 -  WA_GZBItemTitle(工资表设置表) 其中,工资发放条的项目编码为2
    strSQL = "SELECT WA_GZBItemTitle.cGZItemTitle, WA_GZBItemTitle.cExpression " & _
           "From WA_GZBItemTitle " & _
           "WHERE (((WA_GZBItemTitle.cGZGradeNum)='" & strType & "') AND ((WA_GZBItemTitle.iGZBName_id)=2));"

    Set rstTemp = gdbCurrentDB.OpenRecordset(strSQL)
    
    '根据记录数装载参数到数组中
    With rstTemp
        If Not .EOF Then
            .MoveLast
            lngRecCount = .RecordCount
            .MoveFirst
            gvarItemTitle = rstTemp.GetRows(lngRecCount)
        End If
    End With
        
    rstTemp.Close
    
    Set rstTemp = Nothing
    Exit Sub
    
GetRowsErr:
    If Not rstTemp Is Nothing Then Set rstTemp = Nothing
    MsgBox Err.Description, vbCritical + vbOKOnly, "错误"
    
    
End Sub


'------------------------------------------------------------
'获得工资项目参数
'------------------------------------------------------------
Sub GetRowsItem(strType As String)
    On Error GoTo GetRowsErr
    
    Dim rstTemp As Recordset
    Dim strSQL As String
    Dim lngRecCount As Long
    
    '数据来源 -  WA_GZBItem(工资项目表)
    strSQL = "SELECT WA_GZtblset.cSetGZItemName, WA_GZItem.iGZItem_id " & _
           "FROM WA_GZtblset INNER JOIN WA_GZItem ON WA_GZtblset.iGZItem_id = WA_GZItem.iGZItem_id " & _
           "WHERE (((WA_GZItem.cGZGradeNum)='" & strType & "'));"

    Set rstTemp = gdbCurrentDB.OpenRecordset(strSQL)
    
    '根据记录数装载参数到数组中
    With rstTemp
        If Not .EOF Then
            .MoveLast
            lngRecCount = .RecordCount
            .MoveFirst
            gvarItem = rstTemp.GetRows(lngRecCount)
        End If
    End With
        
    rstTemp.Close
    
    Set rstTemp = Nothing
    Exit Sub
    
GetRowsErr:
    If Not rstTemp Is Nothing Then Set rstTemp = Nothing
    MsgBox Err.Description, vbCritical + vbOKOnly, "错误"
    
    
End Sub

'------------------------------------------------------------
'添加工作表
'------------------------------------------------------------
Function AddSheets() As Boolean
    On Error GoTo AddSheetErr
    Dim i As Integer
    
    '按部门添加表页
    With gobjExcel
        For i = 0 To UBound(gvarDept, 2)
            If i + 1 > .Worksheets.Count Then
                .Sheets.Add.Move after:=gobjExcel.Worksheets(gobjExcel.Worksheets.Count)
            End If
            .Worksheets(i + 1).Name = gvarDept(1, i)
        Next i
    End With
    
    AddSheets = True
    Exit Function
    
AddSheetErr:
    AddSheets = False
    MsgBox Err.Description, vbCritical + vbOKOnly, "错误"
    
    
End Function

'------------------------------------------------------------
'输出工资明细数据到Excel表中
'------------------------------------------------------------
Sub ExportList(strType As String, intYear As Integer, intMonth As Integer, intCount As Integer)
    On Error GoTo ExportListErr
    
    Dim strSQL          As String       '查询字符串
    Dim lngRecCount     As Long         '记录数
        
    Dim strCol1         As String       '列(项目)
    Dim strRow1         As String       '行(项目)
    Dim strCol2         As String       '列(数据)
    Dim strRow2         As String       '行(数据)

    Dim strDeptID       As String       '部门编号
    Dim strFieldName    As String       '字段名称
    
    Dim x As Integer                    '循环计数器(记录数)
    Dim y As Integer                    '循环计数器(项目数)
    
    strDeptID = gvarDept(0, intCount)

    '数据来源 - WA_GZData(工资数据表)
    strSQL = "SELECT WA_GZData.* " & _
             "From WA_GZData " & _
             "WHERE (((WA_GZData.cGZGradeNum)='" & strType & "') AND ((WA_GZData.cDept_Num)='" & strDeptID & "') AND ((WA_GZData.iYear)=" & intYear & ") AND ((WA_GZData.iMonth)=" & intMonth & "));"

    '打开记录集
    Set rstTemp = gdbCurrentDB.OpenRecordset(strSQL)
    
    With rstTemp
        If Not .EOF Then
            .MoveLast
            lngRecCount = .RecordCount
            .MoveFirst
        End If
        
        '按部门选择相应的表页
        gobjExcel.Sheets(gvarDept(1, intCount)).Select
        
        '记录数为0则不进行输出
        If lngRecCount > 0 Then
            
            Screen.MousePointer = vbHourglass
                        
            '行输出
            For x = 1 To lngRecCount
                
                '增加空行
                
                strRow1 = Trim(Val(x * 3 - 2))
                strRow2 = Trim(Val(x * 3 - 1))
                         
                '列输出
                For y = 0 To UBound(gvarItemTitle, 2)