frmyh_yhdz.frm

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

                    .CellBackColor = vbWhite
                Next j
            End If
        Next i
    End With
    mfgYhdzd.Row = OldRowYh
    If mfgYhdzd.Row > 0 Then
        mfgYhdzd.Col = 6
    End If
    
    OldRowDw = mfgDwrjz.Row
    With mfgDwrjz
        For i = 1 To .Rows - 1
            .Row = i
            If .TextMatrix(i, 9) = "" And .CellBackColor = &HFFFFC0 Then
                .Row = i
                For j = 0 To .Cols - 1
                    .Col = j
                    .CellBackColor = vbWhite
                Next j
            End If
        Next i
    End With
    mfgDwrjz.Row = OldRowDw
    If mfgDwrjz.Row > 0 Then
        mfgDwrjz.Col = 9
    End If
    IsRefresh = False
End Sub

'保存自动对账结果
Private Sub SaveChange()
'    Debug.Print Now
    With mfgYhdzd
        Set adoCmd = New ADODB.Command
        adoCmd.ActiveConnection = glo.cnnMain
        adoCmd.CommandText = "UPDATE tZW_Yhdzd" & glo.sOperateYear & " SET lqbz = ?" & _
                    " WHERE id = ?"
        Dim paramLqbz As ADODB.Parameter
        Set paramLqbz = adoCmd.CreateParameter("lqbz", adInteger, adParamInput)
        adoCmd.Parameters.Append paramLqbz
        Dim paramId As ADODB.Parameter
        Set paramId = adoCmd.CreateParameter("id", adInteger, adParamInput)
        adoCmd.Parameters.Append paramId
        For i = 1 To .Rows - 1
            If .TextMatrix(i, 6) = "○" Then
                paramLqbz.value = 1
                paramId.value = .TextMatrix(i, 0)
                adoCmd.Execute
            ElseIf .TextMatrix(i, 6) = "" Then
                paramLqbz.value = Null
                paramId.value = .TextMatrix(i, 0)
                adoCmd.Execute
            End If
        Next i
    End With
'    Debug.Print Now
    
    With mfgDwrjz
        Set adoCmd = New ADODB.Command
        adoCmd.ActiveConnection = glo.cnnMain
        adoCmd.CommandText = "UPDATE tZW_Pzsj" & glo.sOperateYear & _
                        " SET yhdz_lqbz = ?, yhdz_id = ? " & _
                        " WHERE kjqj = ? " & _
                        " AND jlhm = ? " & _
                        " AND pzzl = ? " & _
                        " AND pzbh = ? "
        Dim paramYhdz_lqbz As ADODB.Parameter
        Set paramYhdz_lqbz = adoCmd.CreateParameter("yhdz_lqbz", adInteger, adParamInput)
        adoCmd.Parameters.Append paramYhdz_lqbz
        Dim paramYhdz_id As ADODB.Parameter
        Set paramYhdz_id = adoCmd.CreateParameter("yhdz_id", adInteger, adParamInput)
        adoCmd.Parameters.Append paramYhdz_id
        Dim paramKjqj As ADODB.Parameter
        Set paramKjqj = adoCmd.CreateParameter("kjqj", adInteger, adParamInput)
        adoCmd.Parameters.Append paramKjqj
        Dim paramJlhm As ADODB.Parameter
        Set paramJlhm = adoCmd.CreateParameter("jlhm", adInteger, adParamInput)
        adoCmd.Parameters.Append paramJlhm
        Dim paramPzzl As ADODB.Parameter
        Set paramPzzl = adoCmd.CreateParameter("pzzl", adVarChar, adParamInput, 4)
        adoCmd.Parameters.Append paramPzzl
        Dim paramPzbh As ADODB.Parameter
        Set paramPzbh = adoCmd.CreateParameter("pzbh", adVarChar, adParamInput, 4)
        adoCmd.Parameters.Append paramPzbh
        For i = 1 To .Rows - 1
            If .TextMatrix(i, 9) = "○" Then
                paramYhdz_lqbz.value = 1
                paramYhdz_id.value = .TextMatrix(i, 2)
                paramKjqj.value = .TextMatrix(i, 0)
                paramJlhm.value = .TextMatrix(i, 1)
                paramPzzl.value = .TextMatrix(i, 10)
                paramPzbh.value = .TextMatrix(i, 11)
                adoCmd.Execute
            ElseIf .TextMatrix(i, 9) = "" Then
                paramYhdz_lqbz.value = Null
                paramYhdz_id.value = Null
                paramKjqj.value = .TextMatrix(i, 0)
                paramJlhm.value = .TextMatrix(i, 1)
                paramPzzl.value = .TextMatrix(i, 10)
                paramPzbh.value = .TextMatrix(i, 11)
                adoCmd.Execute
            End If
        Next i
    End With
End Sub

'银行反对账
Private Sub Yhfdz()
    Dim YhCurRow As Integer
    Dim DwCurRow As Integer
    
    IsRefresh = True
    chkYdz.value = 1
    '将所有行高为零的行恢复缺省值; 注:行号为-1代表所有的行
    With mfgDwrjz
        For i = 1 To .Rows - 1
            .RowHeight(i) = 225
        Next i
    End With
    With mfgYhdzd
        For i = 1 To .Rows - 1
            .RowHeight(i) = 225
        Next i
    End With
    '将单位日记账中所有手工核销的记录取消两清标志;
    For DwCurRow = 1 To mfgDwrjz.Rows - 1
        If mfgDwrjz.TextMatrix(DwCurRow, 9) = "√" Then
            mfgDwrjz.TextMatrix(DwCurRow, 9) = ""
        End If
    Next DwCurRow
    '将银行对账单中所有手工核销的记录取消两清标志;
    For YhCurRow = 1 To mfgYhdzd.Rows - 1
        If mfgYhdzd.TextMatrix(YhCurRow, 6) = "√" Then
            mfgYhdzd.TextMatrix(YhCurRow, 6) = ""
        End If
    Next YhCurRow
    '取消所有日期小于反对账截止日期的单位日记账或者银行对账单的两清标志;
    For DwCurRow = 1 To mfgDwrjz.Rows - 1
        If mfgDwrjz.TextMatrix(DwCurRow, 9) = "○" Then
            For YhCurRow = 1 To mfgYhdzd.Rows - 1
                If mfgYhdzd.TextMatrix(YhCurRow, 6) = "○" And _
                    mfgDwrjz.TextMatrix(DwCurRow, 2) = mfgYhdzd.TextMatrix(YhCurRow, 0) Then
                    If mfgDwrjz.TextMatrix(DwCurRow, 3) >= frmYH_Yhfdz.cboYhfdzYue.text Then
                        mfgDwrjz.TextMatrix(DwCurRow, 2) = ""
                        mfgDwrjz.TextMatrix(DwCurRow, 9) = ""
                        mfgYhdzd.TextMatrix(YhCurRow, 6) = ""
                        Exit For
                    Else
                        If mfgYhdzd.TextMatrix(YhCurRow, 1) >= frmYH_Yhfdz.cboYhfdzYue.text Then
                            mfgDwrjz.TextMatrix(DwCurRow, 2) = ""
                            mfgDwrjz.TextMatrix(DwCurRow, 9) = ""
                            mfgYhdzd.TextMatrix(YhCurRow, 6) = ""
                            Exit For
                        End If
                    End If
                End If
            Next YhCurRow
        End If
    Next DwCurRow
    Call ChangeColorWhite
    Call SaveChange
    IsRefresh = False
    '设置银行对账截止日期为当前反对账日期的前一天;
    Select Case g_FLAT
        Case "SQL"
            adoCmd.CommandText = "UPDATE tZW_Yhdzqyrq SET jzrq = '" & _
                    Format(DateAdd("d", -1, CDate(frmYH_Yhfdz.cboYhfdzYue.text)), "yyyy-mm-dd") & _
                    "' WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & "'"
        Case "ORACLE"
            adoCmd.CommandText = "UPDATE tZW_Yhdzqyrq SET jzrq = TO_DATE('" & _
                    Format(DateAdd("d", -1, CDate(frmYH_Yhfdz.cboYhfdzYue.text)), "yyyy-mm-dd") & _
                    "','YYYY-MM-DD') WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & "'"
    End Select
    adoCmd.Execute
End Sub

'根据"frmYH_yhcxtj"查询条件窗体中得到单位日记账查询字符串, 设置单位日记账的行高;
Private Sub QueryDwrjz()
    Dim bTrue As Boolean                '是否满足查询条件

    With frmYH_Yhcxtj
        If .chkNoFilter = 0 Then
            '将所有不满足查询条件的记录的行高设置为零;
            For i = 1 To mfgDwrjz.Rows - 1
                bTrue = True
                If .txtQsrq <> "____-__-__" Then
                    If mfgDwrjz.TextMatrix(i, 3) < .txtQsrq.text Then
                        mfgDwrjz.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .txtJsrq.text <> "____-__-__" Then
                    If mfgDwrjz.TextMatrix(i, 3) > .txtJsrq.text Then
                        mfgDwrjz.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .cboJsfs.text <> "" Then
                    If mfgDwrjz.TextMatrix(i, 5) <> Left(.cboJsfs.text, InStr(.cboJsfs.text, " ") - 1) Then
                        mfgDwrjz.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .txtBill.text <> "" Then
                    If mfgDwrjz.TextMatrix(i, 6) <> .txtBill.text Then
                        mfgDwrjz.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .optJf.value Then
                    If mfgDwrjz.TextMatrix(i, 7) <> "借" Then
                        mfgDwrjz.RowHeight(i) = 0
                        bTrue = False
                    End If
                ElseIf .optDf.value Then
                    If mfgDwrjz.TextMatrix(i, 7) <> "贷" Then
                        mfgDwrjz.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .txtQsje.text <> "" Then
                    If Val(Format(mfgDwrjz.TextMatrix(i, 8), "###0.00")) < Val(Format(.txtQsje.text, "###0.00")) Then
                        mfgDwrjz.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .txtJsje.text <> "" Then
                    If Val(Format(mfgDwrjz.TextMatrix(i, 8), "###0.00")) > Val(Format(.txtJsje.text, "###0.00")) Then
                        mfgDwrjz.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If mfgDwrjz.TextMatrix(i, 9) <> "" And chkYdz.value = 0 Then
                    mfgDwrjz.RowHeight(i) = 0
                    bTrue = False
                End If
                '如果以上条件都满足, 则设置行高为缺省值225
                If bTrue Then
                    mfgDwrjz.RowHeight(i) = 225
                End If
                
            Next i
        End If
    End With
End Sub

'从"frmYH_yhcxtj"查询条件窗体中得到银行对账单查询字符串
Private Sub QueryYhdzd()
    Dim bTrue As Boolean                '是否满足查询条件
    
    With frmYH_Yhcxtj
        If .chkNoFilter.value = 0 Then
            For i = 1 To mfgYhdzd.Rows - 1
                bTrue = True
                If .txtQsrq.text <> "____-__-__" Then
                    If mfgYhdzd.TextMatrix(i, 1) < .txtQsrq.text Then
                        mfgYhdzd.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .txtJsrq.text <> "____-__-__" Then
                    If mfgYhdzd.TextMatrix(i, 1) > .txtJsrq.text Then
                        mfgYhdzd.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .cboJsfs.text <> "" Then
                    If mfgYhdzd.TextMatrix(i, 2) <> Left(.cboJsfs.text, InStr(.cboJsfs.text, " ") - 1) Then
                        mfgYhdzd.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .txtBill.text <> "" Then
                    If mfgYhdzd.TextMatrix(i, 3) <> .txtBill.text Then
                        mfgYhdzd.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .optJf.value Then
                    If mfgYhdzd.TextMatrix(i, 4) <> "借" Then
                        mfgYhdzd.RowHeight(i) = 0
                        bTrue = False
                    End If
                ElseIf .optDf.value Then
                    If mfgYhdzd.TextMatrix(i, 4) <> "贷" Then
                        mfgYhdzd.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .txtQsje.text <> "" Then
                    If Val(Format(mfgYhdzd.TextMatrix(i, 5), "###0.00")) < Val(Format(.txtQsje.text, "###0.00")) Then
                        mfgYhdzd.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                If .txtJsje.text <> "" Then
                    If Val(Format(mfgYhdzd.TextMatrix(i, 5), "###0.00")) > Val(Format(.txtJsje.text, "###0.00")) Then
                        mfgYhdzd.RowHeight(i) = 0
                        bTrue = False
                    End If
                End If
                
                If mfgYhdzd.TextMatrix(i, 6) <> "" And chkYdz.value = 0 Then
                    mfgYhdzd.RowHeight(i) = 0
                    bTrue = False
                End If
                
                '如果以上条件都满足, 则设置行高为缺省值225
                If bTrue Then
                    mfgYhdzd.RowHeight(i) = 225
                End If
            Next i
        End If
    End With
End Sub

'匹配与单位日记账当前行金额相同, 方向相反的银行对账单
Private Sub YhdzMatch()
    With mfgYhdzd
        For i = 1 To .Rows - 1
            If Val(Format(.TextMatrix(i, 5), "###0.00")) _
                = Val(Format(mfgDwrjz.TextMatrix(mfgDwrjz.Row, 8), "###0.00")) _
                And .TextMatrix(i, 4) <> mfgDwrjz.TextMatrix(mfgDwrjz.Row, 7) Then
                .RowHeight(i) = 225
            Else
                .RowHeight(i) = 0
            End If
        Next i
    End With
End Sub