frmac_multsel.frm

一个用VB写的财务软件源码

End Sub
'=============================装载帐本========================================
Private Sub LoadAccountBook()
Dim rstTmp As ADODB.Recordset
Dim sSQL As String
    Set rstTmp = New ADODB.Recordset
    rstTmp.CursorLocation = adUseClient
    sSQL = "select * from TFZ_MULACCOUNTBOOK where cname like '" & m_sAccountName & "%' order by CID"
    rstTmp.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
    With lsvAccountBook
         .ColumnHeaders.Clear
         .ListItems.Clear
         .ColumnHeaders.Add , , "编号", 1000
         .ColumnHeaders.Add , , "多栏账名称", 3000
         .ColumnHeaders.Add , , "账式", 2000
         While Not rstTmp.EOF
             .ListItems.Add , , rstTmp.Fields("CID")
             .ListItems(.ListItems.Count).SubItems(1) = Right(rstTmp.Fields("CNAME"), Len(rstTmp.Fields("CNAME")) - Len(m_sAccountName))
             .ListItems(.ListItems.Count).SubItems(2) = rstTmp.Fields("CMODE")
             rstTmp.MoveNext
         Wend
    End With
    rstTmp.Close
    Set rstTmp = Nothing
End Sub
Private Sub LoadItem() '装载项目 并初始化
Dim rstItem As ADODB.Recordset
Dim sSQL As String
    If lsvItemTarget.ListItems.Count > 0 Then Exit Sub
    lsvItemTarget.ColumnHeaders.Add , , "", lsvItemTarget.Width
    lsvItemTarget.Sorted = True
    lsvItemTarget.SortKey = 0
    lsvItemSource.ColumnHeaders.Add , , "", lsvItemSource.Width
    lsvItemSource.Sorted = True
    lsvItemSource.SortKey = 0
    lsvItemSource.ListItems.Clear
    Set rstItem = New ADODB.Recordset
    rstItem.CursorLocation = adUseClient
    If g_FLAT = "SQL" Then
       sSQL = "select * from ((Select rtrim(CCLSCODE) + rtrim(CCODE) CCODE, CNAME  from tZW_Item" & glo.sOperateYear & ")  union (select rtrim(CCLSCODE) CCODE,rtrim(CCLSNAME) CNAME from tzw_itemclass" & glo.sOperateYear & "))  A Order By CCODE"
    Else
       sSQL = "select * from ((Select rtrim(CCLSCODE) || rtrim(CCODE) CCODE, CNAME  from tZW_Item" & glo.sOperateYear & ") union (select rtrim(CCLSCODE) CCODE,rtrim(CCLSNAME) CNAME from tzw_itemclass" & glo.sOperateYear & "))  A Order By CCODE"
    End If
    rstItem.Open sSQL, glo.cnnMain, adOpenStatic, adLockOptimistic
    lsvItemTarget.ListItems.Clear
    While Not rstItem.EOF
          lsvItemSource.ListItems.Add , , rstItem.Fields("CCODE") & "=" & RTrim(rstItem.Fields("CNAME"))
          rstItem.MoveNext
    Wend
    rstItem.Close
    Set rstItem = Nothing
End Sub



''科目改变时判断是否外币或数量
'Private Sub txtSubject_Change()
'Dim iKmType As Integer
'If Trim(txtSubject.text) = "" Then chkSl.Enabled = True: chkWb.Enabled = True: Exit Sub
'iKmType = GetKmSlWbType(txtSubject.text)
'Select Case iKmType
'       Case 1
'          chkSl.Enabled = True
'       Case 2
'          chkWb.Enabled = True
'       Case 3
'          chkSl.Enabled = True: chkWb.Enabled = True
'       Case Else
'          chkSl.Enabled = False: chkWb.Enabled = False
' End Select
'End Sub
Public Sub FillMonth()
    '根据凭证库中记录的情况，统计出统计年份中的最大的月份
    Dim rstTemp As ADODB.Recordset
    Dim sSQL As String
    Dim i As Integer
    
    m_bFormLoad = True
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    sSQL = "SELECT * FROM tSYS_SubSysUsed WHERE AccountID = '" & glo.sAccountID & _
            "' AND SubSysID = '" & gloSys.sSubSysId & "'"
    rstTemp.Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
    With rstTemp
        If .RecordCount > 0 Then
            '如果当前注册年份大于结帐年, 则查询最小月份为一月份、最大月份为一月份；
            If Val(glo.sOperateYear) > Val(.Fields("ModiYear").Value) Then
                m_iMinStartMonth = 0
                m_iMaxEndMonth = 1
            '否则如果注册年份等于结帐年份, 则查询最小月份为
                                            '(如果注册年份等于子系统启用年份, 则等于子系统启用月份;
                                            '否则等于一月份);
                                            '最大月份等于结帐月+1
            ElseIf Val(glo.sOperateYear) = Val(.Fields("ModiYear").Value) Then
                m_iMinStartMonth = IIf(Val(glo.sOperateYear) = Val(.Fields("BeginYear").Value), _
                                    .Fields("BeginMonth").Value - 1, 0)
                m_iMaxEndMonth = .Fields("ModiMonth").Value + 1
            '否则查询最小月份为(如果注册年份等于子系统启用年份, 则等于子系统启用月份;
                                            '否则等于一月份);
                                            '最大月份等于12
            Else
                m_iMinStartMonth = IIf(Val(glo.sOperateYear) = Val(.Fields("BeginYear").Value), _
                                    .Fields("BeginMonth").Value - 1, 0)
                m_iMaxEndMonth = 12
            End If
        End If
        .Close
    End With
    
    '从凭证表中查找已记帐凭证的记录个数，条件kjqj等于最大查询结束月,并且修改标志为2
    '如果不存在, 则最大查询结束月等于最大查询结束月-1
    sSQL = "SELECT COUNT(*) FROM tZW_Pzsj" & glo.sOperateYear & _
            " WHERE kjqj = " & m_iMaxEndMonth & _
            " AND xgbz = '2'"
    With rstTemp
        .Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
        If .Fields(0).Value = 0 Then
            If m_iMaxEndMonth > m_iMinStartMonth Then
                m_iMaxEndMonth = m_iMaxEndMonth - 1
            End If
        End If
        .Close
    End With
    Set rstTemp = Nothing
    
    '从子系统最小可查询月份到12月份添加记录
    cboMonthFrom.Clear
    For i = m_iMinStartMonth + 1 To 12
        cboMonthFrom.AddItem glo.sOperateYear & "." & Format(i, "00")
    Next i
    If cboMonthFrom.ListCount > 0 Then cboMonthFrom.ListIndex = 0
    '从子系统最小可查询月份到12月份添加记录
    cboMonthTo.Clear
    For i = m_iMinStartMonth + 1 To 12
        cboMonthTo.AddItem glo.sOperateYear & "." & Format(i, "00")
        If i = Month(glo.sOperateDate) Then cboMonthTo.text = glo.sOperateYear & "." & Format(i, "00")
    Next i
End Sub
Private Sub cmdCancel_Click(Index As Integer)
Unload Me
End Sub
Private Sub FindStar()
Dim frm As frmAC_RandomMultiColResult
Set frm = New frmAC_RandomMultiColResult
m_sMode = ""
If m_bForeign Then m_sMode = "数量"
If m_bAmount Then m_sMode = m_sMode & "外币"
If m_sMode = "" Then m_sMode = "金额"
m_sMode = m_sMode & "式"
Me.Hide
With frm
     .usMonthFrom = Right(m_sMonthFrom, 2) '开始月
     .usMonthTo = Right(m_sMonthTo, 2) '结束月
     .usSubjectCode = m_sSubjectCode '科目
     .usDeptCode = m_sDeptCode '部门
     .uaItemCodeCollect = m_sItemCodeCollect '项目
     .ubAmount = m_bAmount '是否数量帐
     .ubForeign = m_bForeign '是否外币
     .ubIncludeNotRecordVoucher = m_bIncludeNotRecordVoucher '是否包含未记账凭证
     .ubShowNotMoneyCol = m_bShowNotMoneyCol '是否显示没有金额的列
     .uiLevel = m_iLevel '分析级次
     .usAccountName = m_sAccountName
     .usAccountType = m_sAccountType '帐页类型
     .usMode = m_sMode '分析方式
     .uarrColInformation = m_arrColInformation '栏目信息
     .uMutexID = lMutexID
     .HelpContextID = 304
     .Show
     If Me.tabSelect.Tab = tabSelect.Tabs - 1 Then
        .ubFormLoad = True
         LocateCbo .cboAccountbook, Trim(lsvAccountBook.SelectedItem.text), False
        .ubFormLoad = False
     End If
    .ShowResult
End With
Unload Me
End Sub
Private Sub PressStep(ByRef Index As Integer)
Dim i As Integer, j As Integer
Dim rstTmp As ADODB.Recordset
Dim arrColTmp() As String
Dim iDebitNum As Integer
Dim iCreditNum As Integer
Select Case Index
       Case 0 '第一步
            If SqlStringValid(txtSubject.text) = False Then
                MsgBox "科目不能含有非法的字符！", vbInformation, "提示"
                Exit Sub
            End If

            m_sMonthFrom = cboMonthFrom.text
            m_sMonthTo = cboMonthTo.text
            If Trim(m_sMonthFrom) = "" Or Trim(m_sMonthTo) = "" Then MsgBox "查询月份月份不能为空!", vbInformation, "提示!": GoTo ExitSub
            If m_sMonthFrom > Trim(m_sMonthTo) Then MsgBox "查询开始月份不能大于查询结束月份!", vbInformation, "提示!": GoTo ExitSub
            m_sSubjectCode = GetLeftRight(Trim(txtSubject), " ", True)
            m_sDeptCode = ""
             m_sItemCodeCollect = ""
            If chkAccountSel.Value = 0 Then
                If Trim(m_sSubjectCode) = "" Then MsgBox "科目不能为空!": GoTo ExitSub
                If Not CheckKmValid(m_sSubjectCode) Then MsgBox "科目不合法!": GoTo ExitSub
                If uGetSubSubjectMaxJc(m_sSubjectCode) = GetKmJc(m_sSubjectCode) Then MsgBox "该科目科目没有子科目!": GoTo ExitSub
                m_sDeptCode = GetLeftRight(Trim(txtDept), " ", True)
                If m_sDeptCode <> "" And Not CheckDeptValid(m_sDeptCode) Then MsgBox "部门不合法": GoTo ExitSub
            End If
            m_bIncludeNotRecordVoucher = chkNotRecordVoucher.Value
            m_bShowNotMoneyCol = chkShowNotMoneyCol.Value
            m_bAmount = IIf(chkSl.Enabled, chkSl.Value, False)
            m_bForeign = IIf(chkWb.Enabled, chkWb.Value, False)
'            Call LoadItem '装项目
       Case 1 '第二步
            With cboAnalyseObj
                 .Clear
                 .AddItem "科目"
                 .AddItem "部门"
                 .AddItem "项目"
                 m_sItemCodeCollect = ""
                 For i = 1 To lsvItemTarget.ListItems.Count
                     m_sItemCodeCollect = m_sItemCodeCollect & GetLeftRight(lsvItemTarget.ListItems(i).text, "=", True) & ","
                 Next
                 m_sItemCodeCollect = Trim(m_sItemCodeCollect)
                 If m_sItemCodeCollect <> "" Then
                    m_sItemCodeCollect = DelLastChar(m_sItemCodeCollect, 1) '去最左边的逗号
                 End If
                 If .ListCount > 0 Then .ListIndex = 0
            End With
       Case 2 '第三步
            If cboAnalyseObj.text = "科目" Then
                m_sAccountType = "科目"
            ElseIf cboAnalyseObj.text = "部门" Then
                m_sAccountType = "部门"
            Else
                m_sAccountType = "项目"
            End If
            If chkAnalyseLastLevel.Value Then
               m_iLevel = 0
            Else
               m_iLevel = cboAnalyseLevel.text
            End If
            With lsvAnalyseCol
                .ColumnHeaders.Clear
                .ColumnHeaders.Add , , m_sAccountType & "代码", 2000
                .ColumnHeaders.Add , , m_sAccountType & "名称", 1800
                .ColumnHeaders.Add , , "级次", 600
                .ColumnHeaders.Add , , "方向", 600
                .ColumnHeaders.Add , , "排序", 0
            End With
            Select Case m_sAccountType
                   Case "科目"
                         arrColTmp = Split(GetLastKmdm(m_sSubjectCode, m_iLevel), ",", , vbTextCompare)
                   Case "部门"
                         arrColTmp = Split(GetLastDeptCode(m_sDeptCode, m_iLevel), ",", , vbTextCompare)
                   Case "项目"
                         arrColTmp = Split(GetLastItemCode(m_sItemCodeCollect, m_iLevel), ",", , vbTextCompare)
            End Select
            With lsvAnalyseCol
                .ListItems.Clear
                .Sorted = False
                iDebitNum = 0: iCreditNum = 0
                For i = LBound(arrColTmp) To UBound(arrColTmp)
                     .ListItems.Add , , arrColTmp(i)
                     If m_sAccountType = "科目" Then
                        .ListItems(i + 1).SubItems(1) = GetKmName(arrColTmp(i), False)
                        .ListItems(i + 1).SubItems(2) = GetKmJc(arrColTmp(i))
                     ElseIf m_sAccountType = "部门" Then
                        .ListItems(i + 1).SubItems(1) = GetDeptName(arrColTmp(i), False)
                        .ListItems(i + 1).SubItems(2) = GetDeptJc(arrColTmp(i))
                     Else
                         .ListItems(i + 1).SubItems(1) = GetItemName(arrColTmp(i), False)
                         .ListItems(i + 1).SubItems(2) = GetItemJc(arrColTmp(i))
                     End If
                     .ListItems(i + 1).SubItems(3) = IIf(m_sAccountType = "科目", GetKmFx(arrColTmp(i)), "借方")
                     If .ListItems(i + 1).SubItems(3) = "借方" Then
                         iDebitNum = iDebitNum + 1
                         .ListItems(i + 1).SubItems(4) = "A" & Format(i, "0000")
                     Else
                         iCreditNum = iCreditNum + 1
                         .ListItems(i + 1).SubItems(4) = "B" & Format(i, "0000")
                     End If
                     .ListItems(i + 1).Checked = True
                Next
                .ListItems.Add , , "借方合计"
                .ListItems(i + 1).SubItems(1) = "借方合计"
                .ListItems(i + 1).SubItems(2) = ""
                .ListItems(i + 1).SubItems(3) = "借方"
                .ListItems(i + 1).SubItems(4) = "A" & Format(i, "0000")
                .ListItems(i + 1).Checked = IIf(iDebitNum = 0, False, True)
                .ListItems.Add , , "贷方合计"
                .ListItems(i + 2).SubItems(1) = "贷方合计"
                .ListItems(i + 2).SubItems(2) = ""
                .ListItems(i + 2).SubItems(3) = "贷方"
                .ListItems(i + 2).SubItems(4) = "B" & Format(i, "0000")
                .ListItems(i + 2).Checked = IIf(iCreditNum = 0, False, True)
                .Sorted = True
                .SortKey = 4
            End With
       Case 3 '第四步
            Dim sTmp As String
            sTmp = ""
            With lsvAnalyseCol
                 If GetListCheckCount <= 0 Then MsgBox "没有查询多栏账，请选择！": GoTo ExitSub
                 If GetListCheckCount > AccountColCount Then MsgBox "查询多栏账不能超过" & AccountColCount & "，请重新选择！": GoTo ExitSub
                 j = 0
                 For i = 1 To .ListItems.Count
                     If .ListItems(i).Checked Then
                        ReDim Preserve m_arrColInformation(j)
                        Set m_arrColInformation(j) = New clsSubSys
                        m_arrColInformation(j).sColCode = .ListItems(i).text
                        m_arrColInformation(j).sColName = .ListItems(i).SubItems(1)
                        m_arrColInformation(j).iColLevel = Val(.ListItems(i).SubItems(2))
                        m_arrColInformation(j).sColDirect = .ListItems(i).SubItems(3)
                        m_arrColInformation(j).iColNum = .ListItems(i).Index
                        j = j + 1
                        If .ListItems(i).text <> "借方合计" And .ListItems(i).text <> "贷方合计" Then
                           sTmp = sTmp & .ListItems(i).text & ","
                       End If
                     End If
                 Next
                 If j <= 0 Then MsgBox "没有查询多栏账，请选择！": GoTo ExitSub
                 sTmp = DelLastChar(sTmp, 1)
                 If m_sAccountType = "科目" Then
                     If m_sSubjectCode = "" Then
                        m_sSubjectCode = sTmp
                     End If
                 ElseIf m_sAccountType = "部门" Then
                     If m_sDeptCode = "" Then
                        m_sDeptCode = sTmp
                     End If
                 Else
                     If m_sItemCodeCollect = "" Then
                        m_sItemCodeCollect = sTmp