frmsalarymonney.frm

金算盘软件代码

                        Next mlngCurPage
                    Else                                '按顺序 2 打印，起始页必须为偶数 (2,4,6)
                        For mlngCurPage = lngStartPage + IIf(lngStartPage Mod 2 = 0, 0, 1) To lngEndPage Step 2 '2,4,6
'                            SetData
                            For i = 1 To frm.GCopiesPrint
                            'Load frmPrintMsg
                            'frmPrintMsg.Show
                            'frmPrintMsg.lblCurrPage.Caption = mlngCurPage
                            SetData
                            ABook.PrintDirect
                            'Unload frmPrintMsg
                            Next i
                        Next mlngCurPage
                    End If
                    
                End If '单面打印
            End If '逐份打印
        
            ABook.EndPrint
            mlngCurPage = oldPage
            SetData
        Else                '输出到文件
            Dim clsFileSever As New FileSeverClass
            If frm.GintFileType = 4 Then
                If Not clsFileSever.Saveas(frm.GStrFileName, 4, , , msgAccount, , "工资配款表", frm.GintFileIndex) Then
                    Utility.ShowMsg Me.hwnd, "文件保存不成功!", vbOKOnly + vbInformation, App.title
                End If
            Else
                If Not clsFileSever.Saveas(frm.GStrFileName, frm.GintFileType, , , msgAccount, , "工资配款表") Then
                    Utility.ShowMsg Me.hwnd, "文件保存不成功!", vbOKOnly + vbInformation, App.title
                End If
            End If
            Set clsFileSever = Nothing
        End If
    End If
    Set frm = Nothing
End Sub

Private Sub Form_Activate()
    If (Me.Left + Me.Width < 0 Or Me.Left > Screen.Width) And mblnLoaded Then
        Me.Left = 300
    End If
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub mclsMainControl_ListActivityMenu(ByVal intIndex As Integer)
    Select Case intIndex
        Case 0, 1, 2
            ABook.FCAlignment(0) = intIndex
        Case 4, 5, 6
            ABook.FCAlignment(0) = intIndex - 1
        Case 8, 9, 10
            ABook.FCAlignment(0) = intIndex - 2
    End Select
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0
        cmdAccSet_Click
    Case 1
        cmdFormatSet_Click
    Case 2
    Case 3
         
    Case 4
         
    Case 5
    Case 6
        CmdPrint_Click
    End Select
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'                      *             辅助支持                  *
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'刷新纪录
Private Sub RefreshData()
    Dim blnPage As Boolean
    SetRecBook                                     '得到记录集
    blnPage = DispartPage                          '分页
    If blnPage Then SetData                        '填充数据
End Sub
'生成新记录集
Private Sub SetRecBook()
    Dim lngSalaryListID As Long
    Dim strSql As String
    'Dim recDepartment As Recordset
    Dim recDepartment As rdoResultset
    Dim strMonneySql As String
    Dim strMonneyDepSql As String
    Dim blnMonneyType As Boolean
    Dim strMonneyWhere As String
    Dim lngSourceID As Long
    Dim i As Long, j As Long, k As Long, l As Long
    Dim strZ As String
    'Dim recZ As Recordset
    Dim recZ As rdoResultset
    Dim strX As String
    Dim recX As rdoResultset
    Dim blnFlag As Boolean
    Dim blnIsFlag() As Boolean  '部门是否为计算标志(True计算,False不计算)
    Dim strCode1 As String
    Dim strCode2 As String
    Dim strTmp As String
    Dim strTmpWhere As String
    Dim dblTmp1 As Double
    Dim dblTmp2 As Double
    
    blnMonneyType = Salary.MonneyType
    strMonneyWhere = Salary.MonneyWhereSQL
    strMonneyDepSql = Salary.MonneyDepSQL
    strMonneySql = Salary.MonneySQL
    lngSourceID = Salary.MonneySourceID
    If blnMonneyType Then   '部门配款情况表
        '得到工资配款表msgACcount标题
        'strSql = "SELECT Department.strDepartmentCode AS 部门编号 , " & _
                 " Department.strDepartmentName AS 部门名称,"
        strSql = "SELECT Department.strDepartmentCode AS ""部门编号"" , " & _
                 " Department.strDepartmentName AS ""部门名称"","
        If strMonneyWhere <> "" Then
            strSql = strSql & strMonneyDepSql & " And " & strMonneyWhere
        Else
            strSql = strSql & strMonneyDepSql
        End If
        strSql = strSql & "  Group BY Department.strDepartmentCode,Department.strDepartmentName" & _
                 " ORDER BY Department.strDepartmentCode  "
        'Set recDepartment = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        Set recDepartment = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        'Set Data2.Recordset = recDepartment
        Set Data2.Resultset = recDepartment
        recDepartment.Close
        Set recDepartment = Nothing
        With msgAccount
            .Rows = 1
            .Cols = msgTmp.Cols
            '取得标题
            For i = 0 To msgTmp.Cols - 1
                .TextMatrix(0, i) = msgTmp.TextMatrix(0, i)
            Next
            'strZ = "SELECT Department.lngDepartmentID, Department.strDepartmentCode, " & _
                   " Department.strDepartmentName FROM Department WHERE Department.blnIsInActive = False "
            strZ = "SELECT Department.lngDepartmentID, Department.strDepartmentCode, " & _
                   " Department.strDepartmentName FROM Department WHERE Department.blnIsInActive = 0 "
            If strMonneyWhere <> "" Then
                strZ = strZ & " AND " & strMonneyWhere
            End If
            strZ = strZ & " ORDER BY Department.strDepartmentCode,Department.strDepartmentName "
            'Set recZ = gclsBase.BaseDB.OpenRecordset(strZ, dbOpenSnapshot)
            Set recZ = gclsBase.BaseDB.OpenResultset(strZ, rdOpenStatic)
            If Not recZ.EOF Then
                'recZ.MoveLast
                'recZ.MoveFirst
                '取得符合条件的部门
                'For i = 0 To recZ.RecordCount - 1
                For i = 0 To recZ.RowCount - 1
                    .Rows = .Rows + 1
                    .TextMatrix(.Rows - 1, 0) = recZ!strDepartmentCode
                    .TextMatrix(.Rows - 1, 1) = recZ!strDepartmentName
                    recZ.MoveNext
                Next
            End If
            recZ.Close
            Set recZ = Nothing
        End With
        With msgAccount
            If .Rows > 1 Then
                ReDim blnIsFlag(.Rows - 1)
                '初始化标志数组
                For i = 1 To .Rows - 1
                    blnIsFlag(i) = True
                Next
                '查找哪些部门不可计算(有明细部门的不计算,为明细部门的合计)
                For i = 1 To .Rows - 1
                    strCode1 = Trim(.TextMatrix(i, 0))
                    strTmp = strCode1 & "-"
                    For j = 1 To .Rows - 1
                        strCode2 = Trim(.TextMatrix(j, 0))
                        If InStr(strCode2, strTmp) = 1 Then
                            blnIsFlag(i) = False
                            Exit For
                        End If
                    Next
                Next
                '计算
                For i = 1 To .Rows - 1
                    If blnIsFlag(i) = True Then
                        strCode1 = Trim(.TextMatrix(i, 0))
                        strTmpWhere = "Instr(Department.strDepartmentCode ,'" & strCode1 & "') =1"
                        'strSql = "SELECT Department.strDepartmentCode AS 部门编号 , " & _
                                 " Department.strDepartmentName AS 部门名称,"
                        
                        strSql = "SELECT Department.strDepartmentCode AS ""部门编号"" , " & _
                                 " Department.strDepartmentName AS ""部门名称"","
                        strSql = strSql & strMonneyDepSql & " AND  " & strTmpWhere
                        strSql = strSql & "  Group BY Department.strDepartmentCode,Department.strDepartmentName"
                        'Set recDepartment = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
                        Set recDepartment = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                        'Set Data2.Recordset = recDepartment
                        Set Data2.Resultset = recDepartment
                        recDepartment.Close
                        Set recDepartment = Nothing
                        If msgTmp.Rows > 1 Then
                            Call RefreshMonneyGrid(msgTmp)
                            '写数据
                            For j = 2 To msgTmp.Cols - 1
                                .TextMatrix(i, j) = IIf(IsNull(msgTmp.TextMatrix(msgTmp.Rows - 2, j)), "", msgTmp.TextMatrix(msgTmp.Rows - 2, j))
                            Next
                        End If
                    End If
                Next
                '逐级汇总
                For i = 1 To .Rows - 1
                    If blnIsFlag(i) = False Then
                        strCode1 = Trim(.TextMatrix(i, 0))
                        strTmp = strCode1 & "-"
                        For j = 1 To .Rows - 1
                            strCode2 = Trim(.TextMatrix(j, 0))
                            If InStr(strCode2, strTmp) = 1 And blnIsFlag(j) = True Then
                                For k = 2 To .Cols - 1
                                    dblTmp1 = IIf(IsNull(.TextMatrix(i, k)), 0, Val(.TextMatrix(i, k)))
                                    dblTmp2 = IIf(IsNull(.TextMatrix(j, k)), 0, Val(.TextMatrix(j, k)))
                                    dblTmp1 = dblTmp1 + dblTmp2
                                    .TextMatrix(i, k) = IIf(dblTmp1 = 0, "", dblTmp1)
                                Next
                            End If
                        Next
                    End If
                Next
                '计算票面合计数和金额合计数
                Call MsgAccountToSum(blnIsFlag())
                GetSumColMonney msgAccount
            Else
                .Rows = .Rows + 1
                .TextMatrix(.Rows - 1, 0) = "票面合计数"
                .Rows = .Rows + 1
                .TextMatrix(.Rows - 1, 0) = "金额合计数"
            End If
        End With
    Else '职员配款情况表
        '取得符合报表设置条件的部门
        'strZ = "SELECT Department.lngDepartmentID, Department.strDepartmentCode, Department.strDepartmentName, " & _
                " Department.strFullName, Department.blnIsInActive, Department.intLevel, Department.blnIsDetail, " & _
                "  Department.strStartDate FROM Department " & _
                " WHERE Department.blnIsInActive=false "
        strZ = "SELECT Department.lngDepartmentID, Department.strDepartmentCode, Department.strDepartmentName, " & _
                " Department.strFullName, Department.blnIsInActive, Department.intLevel, Department.blnIsDetail, " & _
                "  Department.strStartDate FROM Department " & _
                " WHERE Department.blnIsInActive=0 "
        If Trim(strMonneyWhere) <> "" Then
            strZ = strZ & " AND " & strMonneyWhere
        End If
        strZ = strZ & " ORDER BY Department.strDepartmentCode "
        'Set recZ = gclsBase.BaseDB.OpenRecordset(strZ, dbOpenSnapshot)
        Set recZ = gclsBase.BaseDB.OpenResultset(strZ, rdOpenStatic)
        strTmpWhere = ""
        With recZ
            If Not .EOF Then
                '.MoveLast
                '.MoveFirst
                'For i = 0 To .RecordCount - 1
                For i = 0 To .RowCount - 1
                    blnFlag = !blnIsDetail
                    strTmp = Trim(!strDepartmentCode)
                    If blnFlag = True Then
                        strTmpWhere = strTmpWhere & " ( Department.strDepartmentCode = '" & strTmp & "' ) OR "
                    Else
                        'strTmpWhere = strTmpWhere & " ( Instr(trim(Department.strDepartmentCode)  , '" & strTmp & "') =1 ) OR "
                        strTmpWhere = strTmpWhere & " ( Instr(RTRIM(Ltrim(Department.strDepartmentCode))  , '" & strTmp & "') =1 ) OR "
                    End If
                    .MoveNext
                Next
            Else
                strTmpWhere = ""
            End If
        End With
        If Trim(strTmpWhere) <> "" Then
            strTmpWhere = Trim(strTmpWhere)
            strTmpWhere = Left(strTmpWhere, Len(strTmpWhere) - 2)
            strSql = strMonneySql & " AND ( " & strTmpWhere & " ) "
        Else
            '没有符合条件的部门就没有相应的职员配款
            strSql = strMonneySql & " And Department.strDepartmentCode = 'Z2000J2000' And Department.strDepartmentCode <> 'Z2000J2000'"
        End If
        'Set Data1.Recordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        Set Data1.Resultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        Call RefreshMonneyGrid(msgAccount)
        GetSumColMonney msgAccount
    End If
    If msgAccount.Rows > 3 Then
        cmdPrint.Enabled = True
    Else
        cmdPrint.Enabled = False
    End If
End Sub
'分页
Private Function DispartPage() As Boolean
Dim intCol As Integer, intRow As Integer
Dim intRecCount As Integer
Dim lngWidth As Long, lngFixedWidth As Long
Dim intColStart() As Integer, intColEnd() As Integer, lngColExpands As Long     '临时保存模块变量
    '页横向扩展
    mlngPageWidth = ABook.ColCount              '得到最大页宽度
    lngColExpands = 0
    ReDim intColStart(lngColExpands)
    ReDim intColEnd(lngColExpands)
    intColStart(0) = 0
    '取固定列宽度
    lngFixedWidth = 0
    For intCol = 0 To msgAccount.FixedCols - 1
        lngFixedWidth = lngFixedWidth + msgAccount.ColWidth(intCol)
        If lngFixedWidth > mlngPageWidth Then
            Utility.ShowMsg Me.hwnd, "固定列太宽!请减小列宽!", vbOKOnly + vbInformation, App.title
            DispartPage = False
            Exit Function
        End If
    Next intCol
    '算列宽
    lngWidth = lngFixedWidth
    For intCol = msgAccount.FixedCols To msgAccount.Cols - 1
        lngWidth = lngWidth + msgAccount.ColWidth(intCol) / Screen.TwipsPerPixelX
        If lngWidth > mlngPageWidth Then
            lngColExpands = lngColExpands + 1
            ReDim Preserve intColStart(lngColExpands)
            ReDim Preserve intColEnd(lngColExpands)
            lngWidth = lngFixedWidth + msgAccount.ColWidth(intCol) / Screen.TwipsPerPixelX
            intColEnd(lngColExpands - 1) = intCol - 1
            intColStart(lngColExpands) = intCol
        End If
    Next intCol
    intColEnd(lngColExpands) = intCol - 1
    mlngColExpands = lngColExpands + 1
    
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '页纵向扩展