frmyh_yhdz.frm

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

                End If
                If (.Fields("yhdz_lqbz").value) > 0 Then
                    mfgDwrjz.Row = i
                    For j = 0 To mfgDwrjz.Cols - 1
                        mfgDwrjz.Col = j
                        mfgDwrjz.CellBackColor = &HFFFFC0
                    Next j
                End If
                .MoveNext
            Next i
        End If
    End With
    mfgDwrjz.Redraw = True
    IsRefresh = False
End Sub

'填充银行对账单表格
Private Sub FillGridYhf(ByVal sSQLTempYhf As String)

    IsRefresh = True
    mfgYhdzd.Redraw = False
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    rstTemp.Open sSQLTempYhf, glo.cnnMain, adOpenStatic, adLockReadOnly
    With rstTemp
        mfgYhdzd.Rows = 1
        If .RecordCount <> 0 Then
            .MoveFirst
            For i = 1 To .RecordCount
                If IsNull(.Fields("lqbz").value) Then
                    sLqbz = ""
                ElseIf .Fields("lqbz").value = 1 Then
                    sLqbz = "○"
                Else
                    sLqbz = "√"
                End If
                mfgYhdzd.AddItem .Fields("id").value & vbTab & _
                                 Format(.Fields("rq").value, "yyyy-mm-dd") & vbTab & _
                                 Trim$("" & .Fields("jsfsCode").value) + " " + GetJsfsName(Trim$("" & .Fields("jsfsCode").value)) & vbTab & _
                                 Trim$("" & .Fields("bill").value) & vbTab & _
                                 .Fields("fx").value & vbTab & _
                                 Format(.Fields("je").value, "##,##0.00") & vbTab & _
                                 sLqbz & vbTab & _
                                 Trim$("" & .Fields("zy").value) & vbTab & i
                If (.Fields("lqbz").value) > 0 Then
                    mfgYhdzd.Row = i
                    For j = 0 To mfgYhdzd.Cols - 1
                        mfgYhdzd.Col = j
                        mfgYhdzd.CellBackColor = &HFFFFC0
                    Next j
                End If
                .MoveNext
            Next i
        End If
    End With
    mfgYhdzd.Redraw = True
    IsRefresh = False
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
        picKmmc.Left = Me.ScaleWidth - picKmmc.Width - 30
        mfgDwrjz.Width = Me.ScaleWidth - mfgDwrjz.Left * 2
        mfgDwrjz.Height = (Me.ScaleHeight - mfgDwrjz.Top - 900) / 2
        lblDwrjz.Left = (Me.ScaleWidth - lblDwrjz.Width) / 2
        lblYhdzd.Left = (Me.ScaleWidth - lblYhdzd.Width) / 2
        lblYhdzd.Top = mfgDwrjz.Top + mfgDwrjz.Height + 90
        mfgYhdzd.Top = Me.ScaleHeight - mfgDwrjz.Top - mfgDwrjz.Height + 540
        mfgYhdzd.Width = Me.ScaleWidth - mfgYhdzd.Left * 2
        mfgYhdzd.Height = mfgDwrjz.Height
        chkYdz.Top = Me.ScaleHeight - chkYdz.Height - 30
        fraInfo.Left = Me.ScaleWidth - fraInfo.Width - 30
        fraInfo.Top = Me.ScaleHeight - fraInfo.Height - 30
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Cancel = 0
    Me.Refresh
    
    If Not IsPress Or IsSelect Then
        Me.tbr.Buttons("match").value = tbrUnpressed
        Me.tbr.Refresh
        IsPress = True
        IsSelect = False
    End If
    frmYH_YhdzPhCheck.Show 1
    Me.Refresh
    If Not frmYH_YhdzPhCheck.IsBalance Then
      If MsgBox("是否强行退出银行对账?", vbYesNo) = vbNo Then
        Cancel = 1
        Exit Sub
      End If
    End If
    rstTemp.Close
    Set rstTemp = Nothing
    On Error Resume Next
        Unload frmYH_Yhdztj
        Unload frmYH_Yhfdz
        Unload frmYH_Yhcxtj
        Unload frmYH_YhdzPhCheck
End Sub

'双击表格单位日记账, 如果该行已两清, 则取消该行两清标志并且行的颜色为白色;
'否则该行加上两清标志并且行的颜色为淡蓝色;
Private Sub mfgDwrjz_DblClick()
    IsRefresh = True
    
    With mfgDwrjz
        If .Row = 0 Then Exit Sub
        If .TextMatrix(.Row, 9) = "" Then
            .TextMatrix(.Row, 9) = "√"
            For j = 0 To .Cols - 1
                .Col = j
                .CellBackColor = &HFFFFC0
            Next j
            adoCmd.CommandText = "UPDATE tZW_Pzsj" & glo.sOperateYear & _
                    " SET yhdz_lqbz = 2" & _
                    " WHERE kjqj = " & .TextMatrix(.Row, 0) & _
                    " AND pzzl = '" & .TextMatrix(.Row, 10) & _
                    "' AND pzbh = '" & .TextMatrix(.Row, 11) & _
                    "' AND jlhm = " & .TextMatrix(.Row, 1)
            adoCmd.Execute
            '如果当前记录的日期大于银行对账最大截止日期,
            '则将当前记录的日期赋值给最大截止日期；
            If .TextMatrix(.Row, 3) > MaxJzrq Then
                MaxJzrq = .TextMatrix(.Row, 3)
                Select Case g_FLAT
                    Case "SQL"
                        adoCmd.CommandText = "UPDATE tZW_Yhdzqyrq SET jzrq = '" & MaxJzrq & _
                                "' WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & "'"
                    Case "ORACLE"
                        adoCmd.CommandText = "UPDATE tZW_Yhdzqyrq SET jzrq = TO_DATE('" & MaxJzrq & _
                                "','YYYY-MM-DD') WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & "'"
                End Select
                adoCmd.Execute
            End If
        Else
            If .TextMatrix(.Row, 9) = "○" Then
                For i = 1 To mfgYhdzd.Rows - 1
                    If mfgYhdzd.TextMatrix(i, 0) = .TextMatrix(.Row, 2) Then
                        mfgYhdzd.TextMatrix(i, 6) = ""
                        mfgYhdzd.Row = i
                        For j = 0 To mfgYhdzd.Cols - 1
                            mfgYhdzd.Col = j
                            mfgYhdzd.CellBackColor = vbWhite
                        Next j
                        Exit For
                    End If
                Next i
                adoCmd.CommandText = "UPDATE tZW_Yhdzd" & glo.sOperateYear & " SET lqbz = NULL" & _
                        " WHERE id = " & .TextMatrix(.Row, 2)
                adoCmd.Execute
                .TextMatrix(.Row, 2) = ""
            End If
            .TextMatrix(.Row, 9) = ""
            For j = 0 To .Cols - 1
                .Col = j
                .CellBackColor = vbWhite
            Next j
            adoCmd.CommandText = "UPDATE tZW_Pzsj" & glo.sOperateYear & _
                    " SET yhdz_lqbz = NULL, yhdz_id = NULL" & _
                    " WHERE kjqj = " & .TextMatrix(.Row, 0) & _
                    " AND pzzl = '" & .TextMatrix(.Row, 10) & _
                    "' AND pzbh = '" & .TextMatrix(.Row, 11) & _
                    "' AND jlhm = " & .TextMatrix(.Row, 1)
            adoCmd.Execute
        End If
    End With
    IsRefresh = False
End Sub

Private Sub mfgDwrjz_EnterCell()
    If mfgDwrjz.Row > 0 And Not IsPress And Not IsRefresh Then
        Call YhdzMatch
    End If
End Sub

'双击表格银行对账单, 如果该行已两清, 则取消该行两清标志并且行的颜色为白色;
'否则该行加上两清标志并且行的颜色为淡蓝色;
Private Sub mfgYhdzd_DblClick()
    IsRefresh = True
    With mfgYhdzd
        If .Row = 0 Then Exit Sub
        If .TextMatrix(.Row, 6) = "" Then
            .TextMatrix(.Row, 6) = "√"
            For j = 0 To .Cols - 1
                .Col = j
                .CellBackColor = &HFFFFC0
            Next j
            adoCmd.CommandText = "UPDATE tZW_Yhdzd" & glo.sOperateYear & " SET lqbz = 2" & _
                    " WHERE id = " & .TextMatrix(.Row, 0)
            adoCmd.Execute
            '如果当前记录的日期大于银行对账最大截止日期,
            '则将当前记录的日期赋值给最大截止日期；
            If .TextMatrix(.Row, 1) > MaxJzrq Then
                MaxJzrq = .TextMatrix(.Row, 1)
                Select Case g_FLAT
                    Case "SQL"
                        adoCmd.CommandText = "UPDATE tZW_Yhdzqyrq SET jzrq = '" & MaxJzrq & _
                                "' WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & "'"
                    Case "ORACLE"
                        adoCmd.CommandText = "UPDATE tZW_Yhdzqyrq SET jzrq = TO_DATE('" & MaxJzrq & _
                                "','YYYY-MM-DD') WHERE kmdm = '" & frmYH_Yhkmxz.kmdm & "'"
                End Select
                adoCmd.Execute
            End If
        Else
            If .TextMatrix(.Row, 6) = "○" Then
                For i = 1 To mfgDwrjz.Rows - 1
                    If mfgDwrjz.TextMatrix(i, 2) = .TextMatrix(.Row, 0) Then
                        mfgDwrjz.TextMatrix(i, 9) = ""
                        mfgDwrjz.TextMatrix(i, 2) = ""
                        mfgDwrjz.Row = i
                        For j = 0 To mfgDwrjz.Cols - 1
                            mfgDwrjz.Col = j
                            mfgDwrjz.CellBackColor = vbWhite
                        Next j
                        Exit For
                    End If
                Next i
                adoCmd.CommandText = "UPDATE tZW_Pzsj" & glo.sOperateYear & _
                        " SET yhdz_lqbz = NULL, yhdz_id = NULL" & _
                        " WHERE yhdz_id = " & .TextMatrix(.Row, 0)
                adoCmd.Execute
            End If
            .TextMatrix(.Row, 6) = ""
            For j = 0 To .Cols - 1
                .Col = j
                .CellBackColor = vbWhite
            Next j
            adoCmd.CommandText = "UPDATE tZW_Yhdzd" & glo.sOperateYear & " SET lqbz = NULL" & _
                    " WHERE id = " & .TextMatrix(.Row, 0)
            adoCmd.Execute
        End If
    End With
    IsRefresh = False
End Sub

Private Sub mnuBankCollate_Click()
    Call Operate("BANKCOLLATE")
End Sub

Private Sub mnuCancel_Click()
    Call Operate("CANCEL")
End Sub

Private Sub mnuCheck_Click()
    Call Operate("CHECK")
End Sub

Private Sub mnuExit_Click()
    Call Operate("EXIT")
End Sub

Private Sub mnuFilter_Click()
    Call Operate("SELECT")
End Sub

Private Sub mnuHelp_Click()
    Call Operate("HELP")
End Sub

Private Sub mnuMatch_Click()
    Call Operate("MATCH")
End Sub

Private Sub tbr_ButtonClick(ByVal Button As MSComctlLib.Button)
    Call Operate(UCase(Button.Key))
End Sub

Private Sub Operate(strKey As String)
    With tbr
        Select Case strKey
            Case "BANKCOLLATE"
                frmYH_Yhdztj.Show 1
                Me.Refresh
                If frmYH_Yhdztj.IsOk Then
                    '赋值给最大截止日期
                    MaxJzrq = Format(frmYH_Yhdztj.dtpJzrq, "yyyy-mm-dd")
                    Me.MousePointer = vbHourglass
                    Call Yhzddz
                    'dz
                    Me.MousePointer = vbDefault
                End If
                '每个按钮执行完后, 判断匹配按钮原来是否没按下, 如果是按下, 则保持按钮被按下状态;
                If Not IsPress Then
                    .Buttons("match").value = tbrPressed
                End If
            Case "CANCEL"
                frmYH_Yhfdz.Show 1
                If frmYH_Yhfdz.IsOk Then
                    If MsgBox("是否确认取消" & txtKmmc.text & "账户的对账标志到" & _
                        frmYH_Yhfdz.cboYhfdzYue.text & "?", _
                        vbYesNo + vbQuestion + vbDefaultButton2, "银行反对账") = vbYes Then
                        Me.MousePointer = vbHourglass
                        Call Yhfdz
                        Me.MousePointer = vbDefault
                    End If
                End If
                If Not IsPress Then
                    .Buttons("match").value = tbrPressed
                End If
            Case "SELECT"
                Dim DWFocus As Boolean
                If Me.ActiveControl = mfgDwrjz Then
                    DWFocus = True
                Else
                    DWFocus = False
                End If
                frmYH_Yhcxtj.Show 1
                Me.Refresh
                If frmYH_Yhcxtj.IsOk Then
                    Me.MousePointer = vbHourglass
                    If frmYH_Yhcxtj.chkNoFilter = 1 Then
                        frmYH_Yhcxtj.chkNoFilter = 0
                        '将所有行高为零的行恢复缺省值; 注:行号为-1代表所有的行
                        
                        If Me.ActiveControl = mfgDwrjz Then
                            For i = 1 To mfgDwrjz.Rows - 1
                                mfgDwrjz.RowHeight(i) = 225
                            Next i
                        End If
                        If Me.ActiveControl = mfgYhdzd Then
                            For i = 1 To mfgYhdzd.Rows - 1
                                mfgYhdzd.RowHeight(i) = 225
                            Next i
                        End If