frmyh_dwrjzqc.frm

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

                                        .Fields("jlhm").value & vbTab & _
                                        Format(.Fields("pzrq").value, "yyyy-mm-dd") & vbTab & _
                                        .Fields("pzzl").value & vbTab & _
                                        .Fields("pzbh").value & vbTab & _
                                        Trim$("" & .Fields("yhdz_jsfsCode").value) & " " & Trim$("" & .Fields("yhdz_jsfs").value) & vbTab & _
                                        Trim$("" & .Fields("yhdz_Bill").value) & vbTab & _
                                        Format(.Fields("je").value, "##,##0.00") & vbTab & _
                                        "" & vbTab & _
                                        Format(.Fields("yhdz_Date").value, "yyyy-mm-dd") & vbTab & _
                                        Trim$("" & .Fields("pzzy").value) & vbTab & i
                Else
                    mfgDwrjzqc.AddItem .Fields("kjqj").value & vbTab & _
                                        .Fields("jlhm").value & vbTab & _
                                        Format(.Fields("pzrq").value, "yyyy-mm-dd") & vbTab & _
                                        .Fields("pzzl").value & vbTab & _
                                        .Fields("pzbh").value & vbTab & _
                                        Trim$("" & .Fields("yhdz_jsfsCode").value) & " " & Trim$("" & .Fields("yhdz_jsfs").value) & vbTab & _
                                        Trim$("" & .Fields("yhdz_Bill").value) & vbTab & _
                                        "" & vbTab & _
                                        Format(.Fields("je").value, "##,##0.00") & vbTab & _
                                        Format(.Fields("yhdz_Date").value, "yyyy-mm-dd") & vbTab & _
                                        Trim$("" & .Fields("pzzy").value) & vbTab & i
                End If
                If .Fields("yhdz_lqbz").value > 0 Then
                    mfgDwrjzqc.Row = i
                    For j = 0 To mfgDwrjzqc.Cols - 1
                        mfgDwrjzqc.Col = j
                        mfgDwrjzqc.CellBackColor = &HFFFFC0
                    Next j
                End If
                .MoveNext
            Next i
        End If
    End With
    With mfgDwrjzqc
        For i = 1 To mfgDwrjzqc.Rows - 1
            .RowHeight(i) = cboEdit.Height
        Next i
        .Row = 0
        .Col = 0
    End With
    mfgDwrjzqc.Redraw = True
    IsRefresh = False
End Sub

Private Sub cboEdit_KeyDown(KeyCode As Integer, Shift As Integer)
    With mfgDwrjzqc
        Select Case KeyCode
            Case vbKeyLeft
                If .Col > 0 Then
                    .Col = .Col - 1
                End If
            Case vbKeyRight
                If .Col < .Cols - 1 Then
                    .Col = .Col + 1
                End If
            Case vbKeyReturn
                If .Col < .Cols - 1 Then
                    .Col = .Col + 1
                End If
        End Select
    End With
End Sub


Private Sub cmdHelp_Click()
    frmH_Summ.ubSelectStatus = True
    frmH_Summ.Show 1, Me
    txtEdit.text = frmH_Summ.txtName
End Sub

'根据所按方向键改变表格的焦点
Private Sub dtpEdit_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = 13 Then
    With mfgDwrjzqc
          dtpEdit.Visible = False
         .TextMatrix(.Row, .Col) = Format(dtpEdit.value, "YYYY-MM-DD")
         If .Col < .Cols - 1 Then
            .Col = .Col + 1
         End If
        .Refresh
      End With
   End If
End Sub

'当进入新的单元格时, 判断新的单元格的行数是否于老的单元格行数不同并且老的单元格行数不等于0
'并且当前不是在表格刷新状态并且当前不是在删除状态,
'如果是, 判断老的单元格所在行的数据是否合法,
'如果合法, 判断老的单元格所在行的数据是否被修改并且当前行不是在增加状态,
'如果条件为真, 则修改数据库中表的内容
Private Sub mfgDwrjzqc_EnterCell()
    On Error GoTo err_handle
    With mfgDwrjzqc
        If .Visible And .Row > 0 And Not IsRefresh And Not IsDelete Then
            NewRow = .Row
            '单元格所在行改变后,
            If NewRow <> OldRow Then
                NewCol = .Col
                '当不是在新增状态时
                '进入某一数据行时，先赋值给变量;
                If tbr.Buttons("new").Enabled Then
                    If OldPzzl = "" Then
                        OldPzzl = .TextMatrix(.Row, 3)
                    End If
                    If OldPzbh = "" Then
                        OldPzbh = .TextMatrix(.Row, 4)
                    End If
                End If
                If OldRow > 0 Then
                    If Not IsValidate Then
                        IsRefresh = True
                        .Row = OldRow
                        .Col = ErrorCol
                        IsRefresh = False
                        Exit Sub
                    Else
                        If IsModify Then
                            If NewRow < OldRow Then
                                If Not tbr.Buttons("new").Enabled Then
                                    Call InsertCurrentRow
                                    With tbr
                                        .Buttons("print").Enabled = True
                                        .Buttons("preview").Enabled = True
                                        .Buttons("new").Enabled = True
                                        .Buttons("save").Enabled = False
                                        .Buttons("cancel").Enabled = False
                                        .Buttons("delete").Enabled = True
                                        .Buttons("filter").Enabled = True
                                        .Buttons("exit").Enabled = True
                                        mnuPrint.Enabled = True
                                        mnuPreview.Enabled = True
                                        mnuNew.Enabled = True
                                        mnuSave.Enabled = False
                                        mnuCancel.Enabled = False
                                        mnuDelete.Enabled = True
                                        mnuFilter.Enabled = True
                                        mnuExit.Enabled = True
                                    End With
                                Else
                                    Call UpdateCurrentRow
                                End If
                            Else
                                If Not tbr.Buttons("new").Enabled Then
                                    Call InsertCurrentRow
                                    OldPzzl = .TextMatrix(OldRow, 3)
                                    OldPzbh = .TextMatrix(OldRow, 4)
                                Else
                                    Call UpdateCurrentRow
                                End If
                            End If
                        End If
                        IsModify = False
                        If IsDateModify Then
                            IsDateModify = False
                            Call AutoDateSort
                        End If
                        If tbr.Buttons("new").Enabled Then
                            OldPzzl = .TextMatrix(.Row, 3)
                            OldPzbh = .TextMatrix(.Row, 4)
                        End If
                    End If
                End If
                '存入当前行的凭证种类、凭证日期；
            End If
        End If
    End With
    mfgDwrjzqc_GotFocus1
    Exit Sub
err_handle:
 dtpEdit.Visible = False
 cboEdit.Visible = False
 txtEdit.Visible = False
 txtPjrq.Visible = False
End Sub

'表格中的单元格获得焦点后, 动态的移动相应的控件到当前的单元格;
Private Sub mfgDwrjzqc_GotFocus1()
   On Error GoTo err_handle
    With mfgDwrjzqc
        If .Visible And .Row > 0 And .CellBackColor <> &HFFFFC0 And Not IsRefresh And Not IsDelete Then
            Select Case True
                Case .Col = 2
                    dtpEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                    dtpEdit.Visible = True
                    
                    If .text <> "" Then
                        dtpEdit.value = .text
                    ElseIf .Row > 1 Then
                        dtpEdit.value = CDate(.TextMatrix(.Row - 1, .Col))
                    Else
                        dtpEdit.value = Date
                    End If
                    dtpEdit.SetFocus
                Case .Col = 3, .Col = 5
                    cboEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth
                    cboEdit.Visible = True
                    cboEdit.SetFocus
                 'for循环功能: 找出与表格中选中的结算方式相匹配的组合列表框内容;
                    Call FillCbo
                Case .Col = 4, .Col = 6
                    txtEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                    txtEdit.Visible = True
                    txtEdit.SetFocus
                    txtEdit.text = .text
                    
                Case .Col = 7 Or .Col = 8
                    txtEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                    txtEdit.Visible = True
                    txtEdit.SetFocus
                    txtEdit.text = Format(.text, "###0.00")
                Case .Col = 9
                    txtPjrq.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                    txtPjrq.Visible = True
                    txtPjrq.SetFocus
                    If .text <> "" Then
                        txtPjrq.text = .text
                    Else
                        txtPjrq.text = "____-__-__"
                    End If
                Case .Col = 10
                    txtEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                    txtEdit.Visible = True
                    txtEdit.SetFocus
                    txtEdit.text = .text
                    cmdHelp.Move .Left + .CellLeft + .cellWidth - cmdHelp.Width, .Top + .CellTop + .cellHeight - cmdHelp.Height
                    cmdHelp.Visible = True
            End Select
        End If
    End With
 Exit Sub
err_handle:
 dtpEdit.Visible = False
 cboEdit.Visible = False
 txtEdit.Visible = False
 txtPjrq.Visible = False
End Sub

'根据当前获得焦点的单元格是凭证类别还是结算方式, 填充相应的内容;
Private Sub FillCbo()
    With mfgDwrjzqc
        Select Case True
            Case .Col = 3
                cboEdit.Clear
                cboEdit.AddItem " "
                For i = 1 To UBound(PzlbArray)
                    cboEdit.AddItem PzlbArray(i), i - 1
                Next i
                cboEdit.ListIndex = -1
                For i = 0 To cboEdit.ListCount - 1
                    If Trim(cboEdit.List(i)) = Trim(.text) Then
                        cboEdit.ListIndex = i
                        Exit For
                    End If
                Next i
            Case .Col = 5
                cboEdit.Clear
                For i = 1 To UBound(JsfsArray)
                    cboEdit.AddItem JsfsArray(i), i - 1
                Next i
                cboEdit.ListIndex = -1
                For i = 0 To cboEdit.ListCount - 1
                    If Trim(cboEdit.List(i)) = Trim(.text) Then
                        cboEdit.ListIndex = i
                        Exit For
                    End If
                Next i
        End Select
    End With
End Sub

'离开当前单元格处理
Private Sub mfgDwrjzqc_LeaveCell()
   On Error GoTo err_handle
    With mfgDwrjzqc
        If .Visible And .Row > 0 And Not IsRefresh And Not IsDelete Then
    '赋值当前单元格所在的行数给变量oldrow;
            OldRow = .Row
    '隐藏当前表格中活动的控件 ;

            Select Case True
                Case dtpEdit.Visible
                    If .text <> Format(dtpEdit.value, "yyyy-mm-dd") Then
                        .text = Format(dtpEdit.value, "yyyy-mm-dd")
                        IsModify = True
                        IsDateModify = True
                    End If
                    dtpEdit.Visible = False
                Case cboEdit.Visible
                    If .text <> Trim(cboEdit.text) Then
                        .text = Trim(cboEdit.text)
                        IsModify = True
                    End If
                    cboEdit.Visible = False
                Case txtEdit.Visible, cmdHelp.Visible
                    If .Col = 4 Then
                        If .text <> Format(txtEdit.text, "0000") Then
                            .text = Format(txtEdit.text, "0000")
                            IsModify = True
                        End If
                        txtEdit.Visible = False
                        cmdHelp.Visible = False
                    ElseIf .Col = 7 Then
                        If .text <> Format(txtEdit.text, "##,##0.00") Then
                            If Val(Format(txtEdit.text, "##,##0.00")) = 0 Then
                                .text = ""
                            Else