frmyh_yhdzdlr.frm

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

            GetQc = GetQc - Format(rSt.Fields("je").value, "0.00")
        Else
            GetQc = GetQc + Format(rSt.Fields("je").value, "0.00")
        End If
        GetQc = Format(GetQc, "0.00")
        rSt.MoveNext
    Wend
    rSt.Close
End Function

'增加当前行数据到表
Private Sub InsertCurrentRow()
    Dim maxId As Integer

    IsChangeCurrentTable = True
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    sSQLTemp = "SELECT MAX(id) MaxId FROM tZW_yhdzd" & glo.sOperateYear
    rstTemp.Open sSQLTemp, glo.cnnMain, adOpenStatic, adLockReadOnly
    Select Case g_FLAT
        Case "SQL"
            If IsNull(rstTemp.Fields("MaxId").value) Then
                maxId = 0
            Else
                maxId = rstTemp.Fields("MaxId").value
            End If
        Case "ORACLE"
            If rstTemp.BOF And rstTemp.EOF Then
                maxId = 0
            Else
                maxId = rstTemp.Fields("MaxId").value
            End If
    End Select
    With mfgYhdzdlr
        .TextMatrix(OldRow, 0) = maxId + 1
        .TextMatrix(OldRow, 1) = 2
        '如果借方金额不为零
        If .TextMatrix(OldRow, 5) <> "" Then
            Select Case g_FLAT
                Case "SQL"
                    adoCmd.CommandText = "INSERT INTO tZW_yhdzd" & glo.sOperateYear & _
                                        "(id,rq,kmdm,jsfsCode,jsfsName,bill,fx,je,qcbz,zy) " & _
                                         "VALUES(" & maxId + 1 & ",'" & .TextMatrix(OldRow, 2) & "','" & _
                                                frmYH_Yhkmxz.kmdm & "','" & _
                                                GetJsfsCode(.TextMatrix(OldRow, 3)) & "','" & _
                                                GetJsfsName(.TextMatrix(OldRow, 3)) & "','" & _
                                                .TextMatrix(OldRow, 4) & "','借'," & _
                                                Val(Format(.TextMatrix(OldRow, 5), "###0.00")) & ",2,'" & _
                                                .TextMatrix(OldRow, 8) & "')"
                Case "ORACLE"
                    adoCmd.CommandText = "INSERT INTO tZW_yhdzd" & glo.sOperateYear & _
                                        "(id,rq,kmdm,jsfsCode,jsfsname,bill,fx,je,qcbz,zy) " & _
                                         "VALUES(" & maxId + 1 & ",TO_DATE('" & .TextMatrix(OldRow, 2) & _
                                                "','YYYY-MM-DD'),'" & _
                                                frmYH_Yhkmxz.kmdm & "','" & _
                                                GetJsfsCode(.TextMatrix(OldRow, 3)) & "','" & _
                                                GetJsfsName(.TextMatrix(OldRow, 3)) & "','" & _
                                                .TextMatrix(OldRow, 4) & "','借'," & _
                                                Val(Format(.TextMatrix(OldRow, 5), "###0.00")) & ",2,'" & _
                                                .TextMatrix(OldRow, 8) & "')"
            End Select
        Else
        '如果贷方金额不为零
            Select Case g_FLAT
                Case "SQL"
                    adoCmd.CommandText = "INSERT INTO tZW_yhdzd" & glo.sOperateYear & _
                                        "(id,rq,kmdm,jsfsCode,jsfsname,bill,fx,je,qcbz,zy) " & _
                                         "VALUES(" & maxId + 1 & ",'" & .TextMatrix(OldRow, 2) & "','" & _
                                                frmYH_Yhkmxz.kmdm & "','" & _
                                                 GetJsfsCode(.TextMatrix(OldRow, 3)) & "','" & _
                                                GetJsfsName(.TextMatrix(OldRow, 3)) & "','" & _
                                                .TextMatrix(OldRow, 4) & "','贷'," & _
                                                Val(Format(.TextMatrix(OldRow, 6), "###0.00")) & ",2,'" & _
                                                .TextMatrix(OldRow, 8) & "')"
                Case "ORACLE"
                    adoCmd.CommandText = "INSERT INTO tZW_yhdzd" & glo.sOperateYear & _
                                        "(id,rq,kmdm,jsfsCode,jsfsname,bill,fx,je,qcbz,zy) " & _
                                         "VALUES(" & maxId + 1 & ",TO_DATE('" & .TextMatrix(OldRow, 2) & _
                                                "','YYYY-MM-DD'),'" & _
                                                frmYH_Yhkmxz.kmdm & "','" & _
                                                GetJsfsCode(.TextMatrix(OldRow, 3)) & "','" & _
                                                GetJsfsName(.TextMatrix(OldRow, 3)) & "','" & _
                                                .TextMatrix(OldRow, 4) & "','贷'," & _
                                                Val(Format(.TextMatrix(OldRow, 6), "###0.00")) & ",2,'" & _
                                                .TextMatrix(OldRow, 8) & "')"
            End Select
        End If
        adoCmd.Execute
    End With
End Sub

'修改数据库中表的当前行数据
Private Sub UpdateCurrentRow()

    IsChangeCurrentTable = True
    With mfgYhdzdlr
        If .TextMatrix(OldRow, 5) <> "" Then
            Select Case g_FLAT
                Case "SQL"
                    adoCmd.CommandText = "UPDATE tZW_yhdzd" & glo.sOperateYear & _
                                        " SET rq = '" & .TextMatrix(OldRow, 2) & _
                                        "',jsfsCode = '" & GetJsfsCode(.TextMatrix(OldRow, 3)) & _
                                        "',jsfsname='" & GetJsfsName(.TextMatrix(OldRow, 3)) & _
                                        "',bill = '" & .TextMatrix(OldRow, 4) & _
                                        "',fx = '借" & _
                                        "',je = " & Val(Format(.TextMatrix(OldRow, 5), "###0.00")) & _
                                        ",zy = '" & .TextMatrix(OldRow, 8) & _
                                        "' WHERE id = " & .TextMatrix(OldRow, 0)
                Case "ORACLE"
                    adoCmd.CommandText = "UPDATE tZW_yhdzd" & glo.sOperateYear & _
                                        " SET rq = TO_DATE('" & .TextMatrix(OldRow, 2) & "','YYYY-MM-DD') " & _
                                        ",jsfsCode = '" & GetJsfsCode(.TextMatrix(OldRow, 3)) & _
                                        "',jsfsname='" & GetJsfsName(.TextMatrix(OldRow, 3)) & _
                                        "',bill = '" & .TextMatrix(OldRow, 4) & _
                                        "',fx = '借" & _
                                        "',je = " & Val(Format(.TextMatrix(OldRow, 5), "###0.00")) & _
                                        ",zy = '" & .TextMatrix(OldRow, 8) & _
                                        "' WHERE id = " & .TextMatrix(OldRow, 0)
            End Select
        Else
            Select Case g_FLAT
                Case "SQL"
                    adoCmd.CommandText = "UPDATE tZW_yhdzd" & glo.sOperateYear & _
                                        " SET rq = '" & .TextMatrix(OldRow, 2) & _
                                        "',jsfsCode = '" & GetJsfsCode(.TextMatrix(OldRow, 3)) & _
                                        "',jsfsname='" & GetJsfsName(.TextMatrix(OldRow, 3)) & _
                                        "',bill = '" & .TextMatrix(OldRow, 4) & _
                                        "',fx= '贷" & _
                                        "',je = " & Val(Format(.TextMatrix(OldRow, 6), "###0.00")) & _
                                        ",zy = '" & .TextMatrix(OldRow, 8) & _
                                        "' WHERE ID = " & .TextMatrix(OldRow, 0)
                Case "ORACLE"
                    adoCmd.CommandText = "UPDATE tZW_yhdzd" & glo.sOperateYear & _
                                        " SET rq = TO_DATE('" & .TextMatrix(OldRow, 2) & "','YYYY-MM-DD') " & _
                                        ",jsfsCode = '" & GetJsfsCode(.TextMatrix(OldRow, 3)) & _
                                        "',jsfsname='" & GetJsfsName(.TextMatrix(OldRow, 3)) & _
                                        "',bill = '" & .TextMatrix(OldRow, 4) & _
                                        "',fx= '贷" & _
                                        "',je = " & Val(Format(.TextMatrix(OldRow, 6), "###0.00")) & _
                                        ",zy = '" & .TextMatrix(OldRow, 8) & _
                                        "' WHERE ID = " & .TextMatrix(OldRow, 0)
            End Select
        End If
        adoCmd.Execute
    End With
End Sub

'刷新计算对账单余额
Private Sub RefreshYe()
    Dim iRows As Integer
    With mfgYhdzdlr
'如果是在增加状态, 则需要刷新的行数等于总行数减2
'否则刷新的行数等于总行数减1
        If Not tBr.Buttons("new").Enabled Then
            iRows = .Rows - 2
        Else
            iRows = .Rows - 1
        End If
        For i = 1 To iRows
            If i = 1 Then
                If .TextMatrix(i, 5) <> "" Then
                    .TextMatrix(i, 7) = Format(iYhqcye - Val(Format(.TextMatrix(i, 5), "###0.00")), "##,##0.00")
                Else
                    .TextMatrix(i, 7) = Format(iYhqcye + Val(Format(.TextMatrix(i, 6), "###0.00")), "##,##0.00")
                End If
            Else
                If .TextMatrix(i, 5) <> "" Then
                    .TextMatrix(i, 7) = Format(Val(Format(.TextMatrix(i - 1, 7), "###0.00")) _
                                        - Val(Format(.TextMatrix(i, 5), "###0.00")), "##,##0.00")
                Else
                    .TextMatrix(i, 7) = Format(Val(Format(.TextMatrix(i - 1, 7), "###0.00")) _
                                        + Val(Format(.TextMatrix(i, 6), "###0.00")), "##,##0.00")
                End If
            End If
        Next i
    End With
End Sub

'按日期自动排序
Private Sub AutoDateSort()
    With mfgYhdzdlr
        IsRefresh = True
        .row = 1
        .col = 2
'如果当前是在增加状态, 则行选择范围=总行数-2
'否则行选择范围=总行数-1
        If Not tBr.Buttons("new").Enabled Then
            .RowSel = .Rows - 2
        Else
            .RowSel = .Rows - 1
        End If

        .ColSel = 2
        If .RowSel <> 1 Then
            .Sort = flexSortStringNoCaseAscending
        End If
        If Not tBr.Buttons("new").Enabled Then
            .row = CurrentRowNum
            .col = 2
        Else
            .row = NewRow
            .col = NewCol
        End If
        IsRefresh = False
    End With
    Call mfgYhdzdlr_GotFocus1
End Sub

'窗体被删除时调用
Private Sub Form_Unload(Cancel As Integer)
    If Not tBr.Buttons("new").Enabled Then
        Cancel = 1
        MsgBox "记录没有保存, 不能退出！", vbOKOnly + vbInformation
    Else
        With mfgYhdzdlr
            If .row > 0 Then
                Call mfgYhdzdlr_LeaveCell
                If IsValidate Then
                    Cancel = 0
                    If IsModify Then
                        Call UpdateCurrentRow
                    End If
                    Unload Myfrmcx
                Else
                    Cancel = 1
                    .row = OldRow
                    .col = ErrorCol
                    Call mfgYhdzdlr_GotFocus1
                End If
            Else
                Cancel = 0
                Unload Myfrmcx
            End If
        End With
    End If
    Unload frmH_Summ
    Unload frmP
End Sub

'窗体尺寸改变后, 控件尺寸相应改变
Private Sub Form_Resize()
    If Me.WindowState <> 1 Then
        If Me.Height < 5000 Then
            Me.Height = 5000
        End If
        If Me.Width < 7000 Then
            Me.Width = 7000
        End If
        lblYhdzdqcye.Left = Me.ScaleWidth - lblYhdzdqcye.Width - 30
        mfgYhdzdlr.Height = Me.ScaleHeight - mfgYhdzdlr.Top - fraInfo.Height - 30
        mfgYhdzdlr.Width = Me.ScaleWidth - 2 * mfgYhdzdlr.Left
        fraInfo.Left = Me.ScaleWidth - fraInfo.Width - 30
        fraInfo.Top = Me.ScaleHeight - fraInfo.Height - 30
    End If
End Sub

'动态设置文本框的输入字符的最大长度
Private Sub txtEdit_GotFocus()
    With mfgYhdzdlr
        Select Case True
            Case .col = 4
                txtEdit.MaxLength = 12
                txtEdit.SelStart = 0
                txtEdit.SelLength = Len(txtEdit.text)
            Case .col = 5 Or .col = 6
                txtEdit.MaxLength = 15
                txtEdit.SelStart = 0
                txtEdit.SelLength = Len(txtEdit.text)
            Case .col = 8
                txtEdit.MaxLength = 60
        End Select
    End With
End Sub

'根据所按方向键改变表格中获得焦点的单元格

Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
     With mfgYhdzdlr
        Select Case KeyCode
            Case vbKeyLeft
                If .col > 1 Then
                    .col = .col - 1
                End If
            Case vbKeyRight
                If .col < .Cols - 1 Then
                    .col = .col + 1
                End If
            Case vbKeyUp
                If .row > 1 Then
                    .row = .row - 1
                End If
            Case vbKeyDown
                If .row < .Rows - 1 Then
                    .row = .row + 1
                End If
        End Select
    End With
End Sub

Private Sub txtEdit_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        With mfgYhdzdlr
'如果当前单元格不在最后一列, 则将回车键转换为右方向键;
            If .col < .Cols - 1 Then
                SendKeys "{RIGHT}"
'如果当前单元格在最后一列, 则判断单元格数据是否合法,
'如果合法, 则将活动单元格移到下一行的第二列, 否则将活动单元格移到第五列;
            ElseIf .row < .Rows - 1 Then
                If IsValidate Then
                    .row = .row + 1
                    .col = 2
                Else
                    .col = ErrorCol
                End If
'如果当前表格当前单元格是最后一格并且是在增加状态并且当前行数据合法并且当前增加行不超过1000,
'则新增一行;
            ElseIf Not tBr.Buttons("new").Enabled Then
                If IsValidate Then
                    Call AddNewRow
                Else
                    .col = ErrorCol
                End If
            End If
        End With
    Else
        With mfgYhdzdlr
            If .col = 5 Or .col = 6 Then
                If Len(txtEdit.text) = 15 And txtEdit.SelLength = 0 Then
                    If KeyAscii <> 8 And KeyAscii <> 10 Then
                        KeyAscii = 0
                    End