frmvoucher.frm

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

                    i = i + 1
                Wend
                If bFz Then
                    cllFz.InsertRow iRow + 1, 1, 0
                    FormatFzRow iRow + 1
                    i = 1
                    While i <= m_FzHeadCollection.Count
                        Set iTm = m_FzHeadCollection.Item(i)
                        Select Case iTm.uType
                        'case "yw", "kh", "gys"
                        Case "jsfs", "yhph", "pjh"
                            cllFz.s i, iRow + 1, cllFz.GetCurSheet, cllFz.GetCellString(i, iRow, 0)
                            cllFz.SetCellNote i, iRow + 1, 0, cllFz.GetCellNote(i, iRow, 0)
                        Case "dj", "hl"
                            cllFz.d i, iRow + 1, cllFz.GetCurSheet, cllFz.GetCellDouble(i, iRow, 0)
                        Case "pjrq"
                            If cllFz.GetCellString(i, iRow, 0) = "" Or cllFz.GetCellDouble(i, iRow, 0) = 0 Then
                            Else
                             
                                cllFz.d i, iRow + 1, cllFz.GetCurSheet, cllFz.GetCellDouble(i, iRow, 0)
                            End If
                        End Select
                        i = i + 1
                    Wend
                End If
            End If
        
    End Select
End Sub



Private Sub cllFz_MouseLClick(ByVal col As Long, ByVal row As Long, ByVal updn As Long)
    SaveChangeCol
    SetFzFocus
End Sub

Private Sub cllFz_MouseMoving(ByVal nFlags As Long, ByVal col As Long, ByVal row As Long, ByVal X As Long, ByVal Y As Long)
    SaveChangeCol
End Sub

Private Sub cllFz_MouseRClick(ByVal col As Long, ByVal row As Long, ByVal updn As Long)
Dim iTm As New clsFzHead
Dim iCol As Integer
Dim iRow As Integer
    SaveChangeCol
    SetFzFocus
    Select Case lblStatus.Caption
    Case "新增凭证", "修改凭证"
        If row > 1 Then
            Set iTm = m_FzHeadCollection.Item(col)
            Select Case iTm.uType
            Case "xm"
                Select Case iTm.uStyle
                Case "自由项目(数字型)", "自由项目(字符型)"
                Case Else
                    Set oItemHelp = New HelpItem.clsHelpItem
                    oItemHelp.oGlo = m_oGlo
                    oItemHelp.oGloSys = m_oGloSys
                    With oItemHelp
                        .DisplayItemClass = Trim$(iTm.uCode)
                        .kmdm = Trim$(cllVoucher.GetCellNote(COL_SUBJECT, cllVoucher.GetCurrentRow, 0))
                        .Show 1
                        If .Valid = True Then
                           cllFz.s col, row, cllFz.GetCurSheet, .ItemName
                           cllFz.SetCellNote col, row, 0, .ItemCode
                        End If
                    End With
                    Set oItemHelp = Nothing
                End Select
            Case "bm"
                If Not frmUSU_HelpDepartment Is Nothing Then
                    If frmUSU_HelpDepartment.Visible = True Then Exit Sub
                End If
                With frmUSU_HelpDepartment
                    .Show 1
                    If .Ok = True Then
                       cllFz.s col, row, cllFz.GetCurSheet, .usName
                       cllFz.SetCellNote col, row, 0, .usCode
                    End If
                    Unload frmUSU_HelpDepartment
                End With
            Case "yw"
                If Not frmUSU_HelpPerson Is Nothing Then
                    If frmUSU_HelpPerson.Visible = True Then Exit Sub
                End If
                With frmUSU_HelpPerson
                    .Show 1
                    If .Ok = True Then
                       cllFz.s col, row, cllFz.GetCurSheet, .usName
                       cllFz.SetCellNote col, row, 0, .usCode
                    End If
                    Unload frmUSU_HelpPerson
                End With
            Case "kh"
                If Not frmUSU_Customer Is Nothing Then
                    If frmUSU_Customer.Visible = True Then Exit Sub
                End If
                With frmUSU_Customer
                    .Show 1
                    If .Valid = True Then
                       cllFz.s col, row, cllFz.GetCurSheet, .CustomerName
                       cllFz.SetCellNote col, row, 0, .CustomerCode
                    End If
                    Unload frmUSU_Customer
                End With
            Case "gys"
                If Not frmUSU_Vendor Is Nothing Then
                    If frmUSU_Vendor.Visible = True Then Exit Sub
                End If
                With frmUSU_Vendor
                    .Show 1
                    If .Valid = True Then
                        cllFz.s col, row, cllFz.GetCurSheet, .VendorName
                        cllFz.SetCellNote col, row, 0, .VendorCode
                    End If
                    Unload frmUSU_Vendor
                End With
            Case "gr"
                If Not frmUSU_HelpPerson Is Nothing Then
                    If frmUSU_HelpPerson.Visible = True Then Exit Sub
                End If
                With frmUSU_HelpPerson
                    .Show 1
                    If .Ok = True Then
                       cllFz.s col, row, cllFz.GetCurSheet, .usName
                       cllFz.SetCellNote col, row, 0, .usCode
                    End If
                    Unload frmUSU_HelpPerson
                End With
            Case "jsfs"
                If Not frmUSU_Jsfs Is Nothing Then
                    If frmUSU_Jsfs.Visible = True Then Exit Sub
                End If
                With frmUSU_Jsfs
                    .Show 1
                    If .Valid = True Then
                        cllFz.s col, row, cllFz.GetCurSheet, .JsfsName
                        cllFz.SetCellNote col, row, 0, .JsfsCode
                    End If
                    Unload frmUSU_Jsfs
                End With
            Case "pjlx"
                If Not frmUSU_HelpPjlx Is Nothing Then
                    If frmUSU_HelpPjlx.Visible = True Then Exit Sub
                End If
                With frmUSU_HelpPjlx
                    .Show 1
                    If .Valid = True Then
                        cllFz.s col, row, cllFz.GetCurSheet, .usName
                        cllFz.SetCellNote col, row, 0, .usCode
                        cllFz.SetCellNote col + 1, row, 0, CStr(.uiNumber)
                    Else
                        cllFz.SetCellNote col + 1, row, 0, "0"
                    End If
                    If .ubDqr = False Then
                        cllFz.SetCellNote cllFz.GetCols(0) - 1, row, 0, ""
                        cllFz.SetCellInput cllFz.GetCols(0) - 1, row, 0, 5
                    Else
                        cllFz.SetCellNote cllFz.GetCols(0) - 1, row, 0, "-1"
                        cllFz.SetCellInput cllFz.GetCols(0) - 1, row, 0, 0
                    End If
                End With
                Unload frmUSU_HelpPjlx
            End Select
            SetFzFocus
        End If
    End Select
End Sub

Private Sub cllFz_SelChanged(ByVal col1 As Long, ByVal row1 As Long, ByVal col2 As Long, ByVal row2 As Long)
    SaveChangeCol
End Sub

Private Sub cllVoucher_AllowDelCell(ByVal col As Long, ByVal row As Long, approve As Long)
    Select Case cllVoucher.GetCurrentCol
        Case COL_DEBIT
            cllVoucher.SetCellNextPos COL_DEBIT, cllVoucher.GetCurrentRow, 0, COL_CREDIT, cllVoucher.GetCurrentRow
            cllVoucher.d COL_DEBIT, cllVoucher.GetCurrentRow, cllVoucher.GetCurSheet, 0
            OnVoucherJeChange
        Case COL_CREDIT
            cllVoucher.d COL_CREDIT, cllVoucher.GetCurrentRow, cllVoucher.GetCurSheet, 0
            OnVoucherJeChange
        Case COL_SUBJECT
            cllVoucher.SetCellNote COL_SUBJECT, cllVoucher.GetCurrentRow, 0, ""
            cllVoucher.SetCellInput COL_DEBIT, cllVoucher.GetCurrentRow, 0, 2
            cllVoucher.SetCellInput COL_CREDIT, cllVoucher.GetCurrentRow, 0, 2
    End Select
End Sub

Private Sub cllVoucher_AllowEditCell(ByVal col As Long, ByVal row As Long, approve As Long)
Dim s As String
    Select Case cllVoucher.GetCurrentCol
    Case COL_DEBIT
    
    Case COL_SUBJECT
        s = cllVoucher.GetCellNote(COL_SUBJECT, cllVoucher.GetCurrentRow, 0)
        If s <> "" Then
            cllVoucher.s COL_SUBJECT, cllVoucher.GetCurrentRow, cllVoucher.GetCurSheet, s
        End If
    End Select
End Sub

Private Sub cllVoucher_AllowInputFormula(ByVal row As Long, ByVal col As Long, approve As Long)
    approve = 0
End Sub

Private Sub cllVoucher_AllowMove(ByVal oldcol As Long, ByVal OldRow As Long, ByVal NewCol As Long, ByVal NewRow As Long, approve As Long)
    cllVoucher.SaveEdit
'    cllVoucher_SelChanged NewCol, NewRow, NewCol, NewRow
End Sub

Private Sub cllVoucher_allowsizecol(ByVal col As Long, ByVal row As Long, approve As Long)
    approve = 0
End Sub

Private Sub cllVoucher_EditFinish(text As String, approve As Long)
Dim s As String
Dim sTmp As String
Dim bEdit As Boolean
Dim i As Integer
Dim j As Integer
Dim d As Double
Dim iTm As clsFzHead
Dim FzRow As Integer
    If bAllowNoCheckSaveEdit Then Exit Sub
    If Left$(text, 1) = "'" Then text = Mid(text, 2)
    If InStr(1, text, "'") > 0 Then approve = 0: MsgBox "存在非法字符""'""": Exit Sub
    Select Case cllVoucher.GetCurrentCol
        Case COL_DEBIT
        '    If Trim$(text) = "" Then text = "0"
            If IsNumeric(text) Then
                If Abs(Format(text, "#0.00")) >= 0.01 Then
                    text = Format(text, "#0.00")
                    cllVoucher.d COL_CREDIT, OldRow, cllVoucher.GetCurSheet, 0
                    cllVoucher.d COL_DEBIT, OldRow, cllVoucher.GetCurSheet, Format(text, "#0.00")
                    If m_FzHeadCollection.Count > 0 Then
                        i = 1
                        Do While i <= m_FzHeadCollection.Count
                            Set iTm = m_FzHeadCollection.Item(i)
                            If iTm.uType = "je" Then
                                Exit Do
                            End If
                            i = i + 1
                        Loop
                        If i <= m_FzHeadCollection.Count Then
                            d = 0
                            j = 2
                            If FzRow = 0 Then FzRow = cllFz.GetRows(0) - 1
                            While j < cllFz.GetRows(0)
                                If j <> FzRow Then
                                    d = cllFz.GetCellDouble(i, j, 0) + d
                                End If
                                j = j + 1
                            Wend
                        End If
                        cllFz.d i, cllFz.GetRows(0) - 1, cllFz.GetCurSheet, CDbl(text) - d
                        
                        cllVoucher.SetCellNextPos COL_DEBIT, OldRow, 0, COL_DEBIT, OldRow
                        cllVoucher.SetCellNextPos COL_CREDIT, OldRow, 0, COL_CREDIT, OldRow
    '                    cllVoucher.RdonlyCellColor = cllVoucher.FindColorIndex(RGB(224, 224, 224), 1)
                        cllVoucher.SetCellInput COL_DEBIT, OldRow, 0, 5
                        cllVoucher.SetCellInput COL_CREDIT, OldRow, 0, 5
                        cllVoucher.SetCellNextPos 2, OldRow, 0, 1, OldRow + 1
                        cllFz.Redraw
                    Else
                        cllVoucher.SetCellNextPos COL_DEBIT, OldRow, 0, 1, OldRow + 1
                    End If
                Else
                    cllVoucher.SetCellNextPos COL_DEBIT, OldRow, 0, COL_CREDIT, OldRow
                    cllVoucher.d COL_DEBIT, OldRow, cllVoucher.GetCurSheet, 0
                End If
                OnVoucherJeChange
            End If
        Case COL_CREDIT
        '    If Trim$(text) = "" Then text = "0"
            If IsNumeric(text) Then
                If Abs(Format(text, "#0.00")) >= 0.01 Then
                    text = Format(text, "#0.00")
                    cllVoucher.d COL_DEBIT, OldRow, cllVoucher.GetCurSheet, 0
                    cllVoucher.d COL_CREDIT, OldRow, cllVoucher.GetCurSheet, Format(text, "#0.00")
                    If m_FzHeadCollection.Count > 0 Then
                        i = 1
                        Do While i <= m_FzHeadCollection.Count
                            Set iTm = m_FzHeadCollection.Item(i)
                            If iTm.uType = "je" Then
                                Exit Do
                            End If
                            i = i + 1
                        Loop
                        If i <= m_FzHeadCollection.Count Then
                            d = 0
                            j = 2
                            If FzRow = 0 Then FzRow = cllFz.GetRows(0) - 1
                            While j < cllFz.GetRows(0)
                                If j <> FzRow Then
                                    d = cllFz.GetCellDouble(i, j, 0) + d
                                End If
                                j = j + 1
                            Wend
                        End If
                        cllFz.d i, cllFz.GetRows(0) - 1, cllFz.GetCurSheet, CDbl(text) - d
                        
                        cllVoucher.SetCellNextPos COL_DEBIT, OldRow, 0, COL_DEBIT, OldRow
                        cllVoucher.SetCellNextPos COL_CREDIT, OldRow, 0, COL_CREDIT, OldRow
                        cllVoucher.SetCellInput COL_DEBIT, OldRow, 0, 5
                        cllVoucher.SetCellInput COL_CREDIT, OldRow, 0, 5
                        cllVoucher.SetCellNextPos 2, OldRow, 0, 1, OldRow + 1
                        cllFz.Redraw
                    End If
                Else
                    cllVoucher.d COL_CREDIT, OldRow, cllVoucher.GetCurSheet, 0
                End If
                
                OnVoucherJeChange
            End If
        Case COL_SUBJECT
            s = ResearchSubject(text, Not m_bFullPath)
            If s <> "" Then
                sTmp = text
                text = s
                If sTmp = cllVoucher.GetCellNote(COL_SUBJECT, OldRow, 0) Then
                    bEdit = False
                Else
                    bEdit = True
                End If
                cllVoucher.SetCellNote COL_SUBJECT, OldRow, 0, sTmp
                If IsDisplaySubjectName = True Then
                    cllVoucher.s COL_SUBJECT, OldRow, cllVoucher.GetCurSheet, s
                Else
                    cllVoucher.s COL_SUBJECT, OldRow, cllVoucher.GetCurSheet, sTmp
                    text = sTmp
                End If
                If bEdit = True Then
                    EditSubjectFinish sTmp, s, OldRow
                    If m_FzHeadCollection.Count > 0 Then
                        If cllVoucher.GetCellDouble(COL_DEBIT,