frmyh_yhdzdqc.frm

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

                mnuNew.Enabled = True
                mnuSave.Enabled = False
                mnuCancel.Enabled = False
                mnuDelete.Enabled = True
                mnuFilter.Enabled = True
                mnuExit.Enabled = True
            End With
            Call mfgYhdzdqc_LeaveCell
            With mfgYhdzdqc
                CurrentColNum = .col
                If .Rows = 2 Then
                    .Rows = 1
                    tbr.Buttons("delete").Enabled = False
                    mnuDelete.Enabled = False
                Else
                    .RemoveItem (.row)
                End If
                If .row = 0 Then
                    .col = 0
                Else
                    .col = CurrentColNum
                End If
            End With
        Case "DELETE"
            With mfgYhdzdqc
                If .row > 0 And .CellBackColor <> &HFFFFC0 Then
                    Call mfgYhdzdqc_LeaveCell
                    IsDelete = True
'                    If IsValidate Then
'                        If IsModify Then
'                            Call UpdateCurrentRow
'                        End If
                        
                        CurrentColNum = .col
                        .ScrollBars = flexScrollBarNone
                        For j = .Cols - 1 To 0 Step -1
                            .col = j
                            .CellBackColor = vbMagenta
                        Next j
                        If MsgBox("确认删除当前行?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
                            IsChangeCurrentTable = True
                            adoCmd.CommandText = "DELETE FROM tZW_yhdzd" & glo.sOperateYear & _
                                                " WHERE id = " & .TextMatrix(.row, 0)
                            adoCmd.Execute
                            '当总行数为2时, 不能用'removeitem" 方法, 只能设置总行数为1
                            If .Rows = 2 Then
                                .Rows = 1
                                tbr.Buttons("delete").Enabled = False
                                mnuDelete.Enabled = False
                            Else
                                .RemoveItem (.row)
                            End If
                            .ScrollBars = flexScrollBarBoth
                        Else
                            For j = .Cols - 1 To 0 Step -1
                            .col = j
                            .CellBackColor = vbWhite
                            Next j
                            .ScrollBars = flexScrollBarBoth
                        End If
                        IsDelete = False
                        If .row = 0 Then
                            .col = 0
                        Else
                            .col = CurrentColNum
                        End If
'                    Else
'                        IsDelete = False
'                        .Col = ErrorCol
'                        Call mfgYhdzdqc_GotFocus
'                    End If
                End If
            End With
        Case "FILTER"
            IsChangeCurrentTable = True
            With mfgYhdzdqc
                If .row <> 0 And .CellBackColor <> &HFFFFC0 Then
                    .col = 0
                    If IsValidate Then
                        If IsModify Then
                            Call UpdateCurrentRow
                        End If
                        Call QueryConditionInput
                    Else
                        .col = ErrorCol
                    End If
                Else
                    Call QueryConditionInput
                End If
                '为了筛选后不要调用isvalidate程序,将oldrow设置为零
                OldRow = 0
            End With
        Case "HELP"
            Call ShowHelp
        Case "EXIT"
            Unload Me
    End Select
End Sub

'新增加一行
Private Sub AddNewRow()
    With tbr
        .Buttons("print").Enabled = False
        .Buttons("preview").Enabled = False
        .Buttons("new").Enabled = False
        .Buttons("save").Enabled = True
        .Buttons("cancel").Enabled = True
        .Buttons("delete").Enabled = False
        .Buttons("filter").Enabled = False
        .Buttons("exit").Enabled = False
        mnuPrint.Enabled = False
        mnuPreview.Enabled = False
        mnuNew.Enabled = False
        mnuSave.Enabled = True
        mnuCancel.Enabled = True
        mnuDelete.Enabled = False
        mnuFilter.Enabled = False
        mnuExit.Enabled = False
    End With
    With mfgYhdzdqc
        CurrentRowNum = .Rows
        .AddItem "" & vbTab & "" & vbTab & "" & vbTab & "" & vbTab & _
                            "" & vbTab & "" & vbTab & "" & vbTab & CurrentRowNum
        .RowHeight(CurrentRowNum) = cboEdit.Height
        .row = CurrentRowNum
        .col = 1
    End With
End Sub

'调用查询条件输入窗体
Private Sub QueryConditionInput()
    Myfrmcx.Show 1
    With Myfrmcx
        If .IsOk Then
            If .chkNoFilter = 1 Then
                Call FillGrid(sSQL)
                .chkNoFilter = 0
            Else
                Call FillGrid(GetQueryStr)
            End If
        Else
            If .chkNoFilter = 1 Then
                .chkNoFilter = 0
            End If
        End If
    End With
End Sub

'从"frmYH_yhcxtj"查询条件窗体中得到查询字符串
Private Function GetQueryStr() As String
    With Myfrmcx
        If .chkNoFilter.value = 0 Then
            GetQueryStr = "SELECT * FROM tZW_yhdzd" & glo.sOperateYear & " WHERE "
            If .txtQsrq.text <> "____-__-__" Then
                Select Case g_FLAT
                    Case "SQL"
                        GetQueryStr = GetQueryStr & "rq >= '" & .txtQsrq.text & "' AND "
                    Case "ORACLE"
                        GetQueryStr = GetQueryStr & "rq >= TO_DATE'" & .txtQsrq.text & "','YYYY-MM-DD') AND "
                End Select
            End If
            If .txtJsrq.text <> "____-__-__" Then
                Select Case g_FLAT
                    Case "SQL"
                        GetQueryStr = GetQueryStr & "rq <= '" & .txtJsrq.text & "' AND "
                    Case "ORACLE"
                        GetQueryStr = GetQueryStr & "rq <= TO_DATE('" & .txtJsrq.text & "','YYYY-MM-DD') AND "
                End Select
            End If
            If .cboJsfs.text <> "" Then
                GetQueryStr = GetQueryStr & "jsfsCode = '" & Left(.cboJsfs.text, InStr(.cboJsfs.text, " ") - 1) & "' AND "
            End If
            If .txtBill.text <> "" Then
                GetQueryStr = GetQueryStr & "bill = '" & .txtBill.text & "' AND "
            End If
            If .optJf.value Then
                GetQueryStr = GetQueryStr & "fx = '借' AND "
            ElseIf .optDf.value Then
                GetQueryStr = GetQueryStr & "fx = '贷' AND "
            End If
            If .txtQsje.text <> "" Then
                GetQueryStr = GetQueryStr & "je >= " & Val(Format(.txtQsje.text, "###0.00")) & " AND "
            End If
            If .txtJsje.text <> "" Then
                GetQueryStr = GetQueryStr & "je <= " & Val(Format(.txtJsje.text, "###0.00")) & " AND "
            End If
            GetQueryStr = GetQueryStr & "kmdm = '" & frmYH_Yhkmxz.Kmdm & "' AND qcbz = 1 AND hxbz = 0 ORDER BY rq,jsfsCode,Bill"
        End If
    End With
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
    With rstTemp
        If .BOF And .EOF Then
            maxId = 0
        ElseIf IsNull(.Fields("MaxId").value) Then
            maxId = 0
        Else
            maxId = .Fields("MaxId").value
        End If
    End With
    With mfgYhdzdqc
        .TextMatrix(OldRow, 0) = maxId + 1
        '如果借方金额不为零
        If .TextMatrix(OldRow, 4) <> "" 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, 1) & "','" & _
                                            frmYH_Yhkmxz.Kmdm & "','" & _
                                            GetJsfsCode(.TextMatrix(OldRow, 2)) & "','" & _
                                            GetJsfsName(.TextMatrix(OldRow, 2)) & "','" & .TextMatrix(OldRow, 3) & "','借'," & _
                                            Val(Format(.TextMatrix(OldRow, 4), "###0.00")) & ",1,'" & _
                                            .TextMatrix(OldRow, 6) & "')"
                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, 1) & "','YYYY-MM-DD'),'" & _
                                            frmYH_Yhkmxz.Kmdm & "','" & _
                                            GetJsfsCode(.TextMatrix(OldRow, 2)) & "','" & _
                                            GetJsfsName(.TextMatrix(OldRow, 2)) & "','" & _
                                            .TextMatrix(OldRow, 3) & "','借'," & _
                                            Val(Format(.TextMatrix(OldRow, 4), "###0.00")) & ",1,'" & _
                                            .TextMatrix(OldRow, 6) & "')"
            End Select
        Else
        '如果贷方金额不为零
        
        '=========================================8.12==yao===========================================
        '将Mid(.TextMatrix(OldRow, 2), InStr(.TextMatrix(OldRow, 2)+1, " ") + 1)改为
        'Mid(.TextMatrix(OldRow, 2), InStr(.TextMatrix(OldRow, 2), " ") + 1)
            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, 1) & "','" & _
                                               frmYH_Yhkmxz.Kmdm & "','" & _
                                               GetJsfsCode(.TextMatrix(OldRow, 2)) & "','" & _
                                               GetJsfsName(.TextMatrix(OldRow, 2)) & "','" & _
                                               .TextMatrix(OldRow, 3) & "','贷'," & _
                                               Val(Format(.TextMatrix(OldRow, 5), "###0.00")) & ",1,'" & _
                                               .TextMatrix(OldRow, 6) & "')"
                
                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, 1) & "','YYYY-MM-DD'),'" & _
                                               frmYH_Yhkmxz.Kmdm & "','" & _
                                               GetJsfsCode(.TextMatrix(OldRow, 2)) & "','" & _
                                               GetJsfsName(.TextMatrix(OldRow, 2)) & "','" & _
                                               .TextMatrix(OldRow, 3) & "','贷'," & _
                                               Val(Format(.TextMatrix(OldRow, 5), "###0.00")) & ",1,'" & _
                                               .TextMatrix(OldRow, 6) & "')"
            End Select
    '===================================================================================================
        End If
        adoCmd.Execute
    End With
   
    
End Sub

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

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