frmfi_lockaccount.frm

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

            Exit Sub
        End If
        If HasRecordAccountSubjectInMonth("", CStr(ModiMonthOfOperateYear + 1)) = True Then MsgBox "在" & glo.sOperateYear & "年" & CStr(ModiMonthOfOperateYear + 1) & "月中，含有记账凭证，不能反结账！", vbInformation, "提示": Exit Sub
        If MsgBox("确认是否将" & glo.sOperateYear & "年" & ModiMonthOfOperateYear & "月的账进行反结账", _
                vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
            '如果当前已结账月份是一月份, 则已结账年份=当前操作年份-1,已结账月份=12;
            '否则已结账年份=当前操作年份,已结账月份=当前最大结账月份-1;
            If ModiMonthOfOperateYear = 1 Then
                SubSysModiYear = glo.sOperateYear - 1
                ModiMonthOfOperateYear = 12
            Else
                SubSysModiYear = glo.sOperateYear
                ModiMonthOfOperateYear = ModiMonthOfOperateYear - 1
            End If
            
            '修改系统表中子系统启用表的结账年份和结账月份
            Set adoCmd = New ADODB.Command
            Set adoCmd.ActiveConnection = gloSys.cnnSYS
            adoCmd.CommandText = "UPDATE tSYS_SubSysUsed SET ModiYear = '" & SubSysModiYear & _
                                "', ModiMonth = " & ModiMonthOfOperateYear & _
                                " WHERE AccountId = '" & glo.sAccountID & _
                                "' AND SubSysId = '" & gloSys.sSubSysID & "'"
                                
            adoCmd.Execute
            
            '修改系统内可以进行新业务的最早日期
            If ModiMonthOfOperateYear = 12 Then
                glo.sUnEarlierDate = CStr(CInt(SubSysModiYear) + 1) & "-01-01"
            Else
                '在会计期间表中查找该已结账年、期
                Set rstPeriod = New ADODB.Recordset
                rstPeriod.CursorLocation = adUseClient
                rstPeriod.Open "SELECT * FROM tSYS_Period WHERE AccountID='" & glo.sAccountID & _
                        "' AND year='" & glo.sOperateYear & _
                        "' AND PeriodID=" & ModiMonthOfOperateYear, _
                        gloSys.cnnSYS, adOpenStatic, adLockReadOnly
                glo.sUnEarlierDate = Format(DateAdd("d", 1, _
                            rstPeriod.Fields("toDate").Value), "yyyy-mm-dd")
            End If
    
            '如果当前已结账月份不是十二月, 则反结账后将"确认"按钮激活;
            If ModiMonthOfOperateYear <> 12 Then
                cmdOK.Enabled = True
            End If
            Call FillGrid
        End If
    End If
   
End Sub

'当用户按下"CTRL-R"键后, 执行反结账;
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim CtrlDown As Boolean
    
    CtrlDown = (Shift And vbCtrlMask) > 0
    If KeyCode = vbKeyR And CtrlDown Then
    
        '当注册年份等于已结账年份时,才可以执行反结账
        If glo.sOperateYear = SubSysModiYear Then
            If glo.sOperateYear = SubSysBeginYear And _
                    ModiMonthOfOperateYear < Val(Format(SubSysBeginMonth, "##")) Then
                MsgBox "反结账月份不能小于账务子系统启用月份！", vbOKOnly + vbInformation
                Exit Sub
            End If
            If MsgBox("确认是否将" & glo.sOperateYear & "年" & ModiMonthOfOperateYear & "月的账进行反结账", _
                    vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
                '如果当前已结账月份是一月份, 则已结账年份=当前操作年份-1,已结账月份=12;
                '否则已结账年份=当前操作年份,已结账月份=当前最大结账月份-1;
                If ModiMonthOfOperateYear = 1 Then
                    SubSysModiYear = glo.sOperateYear - 1
                    ModiMonthOfOperateYear = 12
                Else
                    SubSysModiYear = glo.sOperateYear
                    ModiMonthOfOperateYear = ModiMonthOfOperateYear - 1
                End If
                
                '修改系统表中子系统启用表的结账年份和结账月份
                Set adoCmd = New ADODB.Command
                Set adoCmd.ActiveConnection = gloSys.cnnSYS
                adoCmd.CommandText = "UPDATE tSYS_SubSysUsed SET ModiYear = '" & SubSysModiYear & _
                                    "', ModiMonth = " & ModiMonthOfOperateYear & _
                                    " WHERE AccountId = '" & glo.sAccountID & _
                                    "' AND SubSysId = '" & gloSys.sSubSysID & "'"
                                    
                adoCmd.Execute
                
                '修改系统内可以进行新业务的最早日期
                If ModiMonthOfOperateYear = 12 Then
                    glo.sUnEarlierDate = CStr(CInt(SubSysModiYear) + 1) & "-01-01"
                Else
                    '在会计期间表中查找该已结账年、期
                    Set rstPeriod = New ADODB.Recordset
                    rstPeriod.CursorLocation = adUseClient
                    rstPeriod.Open "SELECT * FROM tSYS_Period WHERE AccountID='" & glo.sAccountID & _
                            "' AND year='" & glo.sOperateYear & _
                            "' AND PeriodID=" & ModiMonthOfOperateYear, _
                            gloSys.cnnSYS, adOpenStatic, adLockReadOnly
                    glo.sUnEarlierDate = Format(DateAdd("d", 1, _
                                rstPeriod.Fields("toDate").Value), "yyyy-mm-dd")
                End If
        
                '如果当前已结账月份不是十二月, 则反结账后将"确认"按钮激活;
                If ModiMonthOfOperateYear <> 12 Then
                    cmdOK.Enabled = True
                End If
                Call FillGrid
            End If
        End If
    End If
End Sub

Private Sub form_load()
    Me.KeyPreview = True
    Set adoCmd = New ADODB.Command
    adoCmd.ActiveConnection = glo.cnnMain
    Call FillGrid
End Sub

'填充表格
Private Sub FillGrid()
    With mfgLockAccountDate
        .ColWidth(0) = 800
        .ColWidth(1) = 1000
        .ColAlignment(0) = 4
        .ColAlignment(1) = 4
        
        .Rows = 13
        For i = 1 To .Rows - 1
            .TextMatrix(i, 0) = glo.sOperateYear & "." & Format(i, "00")
            .TextMatrix(i, 1) = ""
        Next i
    End With
    
    '取得账务子系统启用年份、月份
    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
            .MoveFirst
            SubSysBeginYear = .Fields("BeginYear").Value
            SubSysBeginMonth = .Fields("BeginMonth").Value
            SubSysModiYear = .Fields("ModiYear").Value
            SubSysModiMonth = .Fields("ModiMonth").Value
        
            '如果注册年份小于账务子系统结账年份
            '则当前已结账月份 = 12
            '否则如果等于, 则当前已记账月份 = 字段"结账月份"
            '否则如果结账月份小于12月份, 则提示"不允许结账"并退出,
            '     否则结账月份等于字段"结账月份";
            If glo.sOperateYear < .Fields("ModiYear").Value Then
                ModiMonthOfOperateYear = 12
            Else
                ModiMonthOfOperateYear = .Fields("ModiMonth").Value
            End If
        End If
    End With
    
    ''''''''''''''''''
    '增加启用月份颜色
    ''''''''''''''''''
    '当注册年份小于等于结账年份时, 填充表格结账标志栏;
    If glo.sOperateYear <= SubSysModiYear Then
        For i = 1 To ModiMonthOfOperateYear
            mfgLockAccountDate.TextMatrix(i, 1) = "√"
            mfgLockAccountDate.col = 1
            mfgLockAccountDate.row = i
            mfgLockAccountDate.CellBackColor = vbWhite
            mfgLockAccountDate.col = 0
            mfgLockAccountDate.row = i
            mfgLockAccountDate.CellBackColor = vbWhite
        Next i
    End If
    If SubSysBeginYear = glo.sOperateYear Then
        For i = 1 To SubSysBeginMonth - 1
            mfgLockAccountDate.TextMatrix(i, 1) = ""
        Next
        mfgLockAccountDate.col = 1
        mfgLockAccountDate.row = SubSysBeginMonth
        mfgLockAccountDate.CellBackColor = &HFFFF&
        mfgLockAccountDate.col = 0
        mfgLockAccountDate.row = SubSysBeginMonth
        mfgLockAccountDate.CellBackColor = &HFFFF&
    End If
    '如果当前注册年份已结账到十二月,
    '则如果注册年份小于等于结账年份时, 则不允许再结账;
    '否则当前未结账月份等于1月份;
    If ModiMonthOfOperateYear = 12 Then
        If glo.sOperateYear <= SubSysModiYear Then
            cmdOK.Enabled = False
        Else
            NotModiMonth = 1
        End If
    Else
        NotModiMonth = ModiMonthOfOperateYear + 1
    End If
    
    '如果子系统启用年份大于结账年份, 则结账日期等于结账年的12月31日;
    '否则从子系统期间表中取出结账月的月末结算日;
    If SubSysBeginYear > SubSysModiYear Then
        lblLockAccountDate.Caption = SubSysModiYear & "-12-31"
    Else
        '赋值给结账日期标签
        Set rstTemp = New ADODB.Recordset
        rstTemp.CursorLocation = adUseClient
        sSQL = "SELECT * FROM tSYS_Period WHERE AccountId = '" & glo.sAccountID & _
                "' AND PeriodId = " & SubSysModiMonth & _
                " AND Year = '" & SubSysModiYear & "'"
        rstTemp.Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
        lblLockAccountDate.Caption = Format(rstTemp.Fields("todate").Value, "yyyy-mm-dd")
    End If
End Sub
'检查记账月的凭证是否缺号
Private Function IsPzbhCheck(m_sRecordAccountMonth As String) As Boolean
    Dim adoRst As ADODB.Recordset
    Dim iPrePzbh As Integer                 '上一条记录的凭证编号
    Dim iCurPzbh As Integer                 '当前记录的凭证编号
    Dim sPrePzzl As String                  '上一条记录的凭证种类
    Dim i As Integer
    Dim j As Integer
    
    IsPzbhCheck = True
    
    Set adoRst = New ADODB.Recordset
    With adoRst
        .CursorLocation = adUseClient
        .Open "SELECT DISTINCT pzzl,pzbh FROM tZW_Pzsj" & glo.sOperateYear & _
                " WHERE kjqj = " & CInt(m_sRecordAccountMonth) & _
                " ORDER BY pzzl,pzbh", _
            glo.cnnMain, adOpenStatic, adLockReadOnly
        i = 0
        If .RecordCount > 0 Then
            Do Until .EOF
                i = i + 1
                If i = 1 Then
                    iPrePzbh = 1
                    sPrePzzl = .Fields("pzzl").Value
                Else
                    '如果当前记录的凭证种类和上一条记录的凭证种类相同
                    If .Fields("pzzl").Value = sPrePzzl Then
                        iCurPzbh = CInt(.Fields("pzbh").Value)
                        '如果当前记录的凭证编号不等于上一条记录的凭证编号加1,则找出缺的凭证号
                        If iCurPzbh <> iPrePzbh + 1 Then
                            IsPzbhCheck = False
                            Exit Do
                        End If
                    End If
                    iPrePzbh = CInt(.Fields("pzbh").Value)
                    sPrePzzl = .Fields("pzzl").Value
                End If
                .MoveNext
            Loop
        End If
        .Close
    End With
    Set adoRst = Nothing
 
End Function