frmvoucher.frm

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

            End If
        Else
            approve = 0
        End If
    Case "dqr"
      On Error GoTo error
        If IsDate(CDate(text)) Then
             

        Else
            approve = 0
        End If
    Case "xm"
        Select Case iTm.uStyle
        Case "自由项目(数字型)", "自由项目(字符型)"
        Case Else
            Set oItemHelp = New HelpItem.clsHelpItem
            oItemHelp.oGlo = m_oGlo
            oItemHelp.oGloSys = m_oGloSys
            oItemHelp.DisplayItemClass = Trim$(iTm.uCode)
            oItemHelp.LoadFrm
            If oItemHelp.IsExitNode(Trim$(text)) Then
                s = Trim$(text)
                sText = oItemHelp.GetText(text)
                pos = InStr(1, sText, "=") + 1
                text = Mid$(sText, pos)
                cllFz.SetCellNote iCol, iRow, 0, s
                cllFz.s iCol, iRow, cllFz.GetCurSheet, text
                sCode = s
                sName = text
            Else
                MsgBox "请输入合法的项目！"
                approve = 0
            End If
            Set oItemHelp = Nothing
        End Select
    Case "bm"
        Load frmUSU_HelpDepartment
        If IsExitNodeInTreeView("K" + Trim$(text), frmUSU_HelpDepartment.tVw) Then
            s = Trim$(text)
            sText = frmUSU_HelpDepartment.tVw.Nodes("K" + s).text
            pos = InStr(1, sText, "=") + 1
            text = Mid$(sText, pos)
            cllFz.SetCellNote iCol, iRow, 0, s
            cllFz.s iCol, iRow, cllFz.GetCurSheet, text
            sCode = s
            sName = text
        Else
            MsgBox "请输入合法的代码！"
            approve = 0
        End If
        Unload frmUSU_HelpDepartment
    Case "yw", "gr"
        Load frmUSU_HelpPerson
        If IsExitNodeInTreeView("k" + Trim$(text), frmUSU_HelpPerson.tVw) Then
            s = Trim$(text)
            sText = frmUSU_HelpPerson.tVw.Nodes("k" + s).text
            pos = InStr(1, sText, "=") + 1
            text = Mid$(sText, pos)
            cllFz.SetCellNote iCol, iRow, 0, s
            cllFz.s iCol, iRow, cllFz.GetCurSheet, text
            sCode = s
            sName = text
        Else
            MsgBox "请输入合法的人员代码！"
            approve = 0
        End If
        Unload frmUSU_HelpPerson
    Case "kh"
        Load frmUSU_Customer
        If IsExitNodeInTreeView("P" + Trim$(text), frmUSU_Customer.tvwKh) Then
            s = Trim$(text)
            sText = frmUSU_Customer.tvwKh.Nodes("P" + s).text
            pos = InStr(1, sText, "=") + 1
            text = Mid$(sText, pos)
            cllFz.SetCellNote iCol, iRow, 0, s
            cllFz.s iCol, iRow, cllFz.GetCurSheet, text
            sCode = s
            sName = text
        Else
            MsgBox "请输入合法的客户代码！"
            approve = 0
        End If
        Unload frmUSU_Customer
    Case "gys"
        Load frmUSU_Vendor
        If IsExitNodeInTreeView("P" + Trim$(text), frmUSU_Vendor.tvwGys) Then
            s = Trim$(text)
            sText = frmUSU_Vendor.tvwGys.Nodes("P" + s).text
            pos = InStr(1, sText, "=") + 1
            text = Mid$(sText, pos)
            cllFz.SetCellNote iCol, iRow, 0, s
            cllFz.s iCol, iRow, cllFz.GetCurSheet, text
            sCode = s
            sName = text
        Else
            MsgBox "请输入合法的供应商代码！"
            approve = 0
        End If
        Unload frmUSU_Vendor
    Case "jsfs"
        Load frmUSU_Jsfs
        If IsExitNodeInTreeView("A" + Trim$(text), frmUSU_Jsfs.tvwJsfs) Then
            s = Trim$(text)
            sText = frmUSU_Jsfs.tvwJsfs.Nodes("A" + s).text
            pos = InStr(1, sText, "=") + 1
            text = Mid$(sText, pos)
            cllFz.SetCellNote iCol, iRow, 0, s
            cllFz.s iCol, iRow, cllFz.GetCurSheet, text
            sCode = s
            sName = text
        Else
            MsgBox "请输入合法的结算方式代码！"
            approve = 0
        End If
        Unload frmUSU_Jsfs
    Case "pjlx"
        Load frmUSU_HelpPjlx
        If IsExitNodeInTreeView("y" + Trim$(text), frmUSU_HelpPjlx.tVw) Then
            s = Trim$(text)
            sText = frmUSU_HelpPjlx.tVw.Nodes("y" + s).text
            pos = InStr(1, sText, "=") + 1
            text = Mid$(sText, pos)
            frmUSU_HelpPjlx.tVw.Nodes("y" + s).Selected = True
            frmUSU_HelpPjlx.RefreshVar
            cllFz.SetCellNote iCol + 1, iRow, 0, CStr(frmUSU_HelpPjlx.uiNumber)
            cllFz.SetCellNote iCol, iRow, 0, s
            If frmUSU_HelpPjlx.ubDqr = False Then
                cllFz.SetCellNote cllFz.GetCols(0) - 1, iRow, 0, ""
                cllFz.SetCellInput cllFz.GetCols(0) - 1, iRow, 0, 5
            Else
                cllFz.SetCellNote cllFz.GetCols(0) - 1, iRow, 0, "-1"
                cllFz.SetCellInput cllFz.GetCols(0) - 1, iRow, 0, 0
            End If
            cllFz.s iCol, iRow, cllFz.GetCurSheet, text
            sCode = s
            sName = text
            s = cllFz.GetCellString(iCol + 1, iRow, 0)
            If Len(s) > CInt(cllFz.GetCellNote(iCol + 1, iRow, 0)) And CInt(cllFz.GetCellNote(iCol + 1, iRow, 0)) > 0 Then
                cllFz.s iCol + 1, iRow, cllFz.GetCurSheet, Left$(s, CInt(cllFz.GetCellNote(iCol + 1, iRow, 0)))
            End If
        Else
            MsgBox "请输入合法的票据类型代码！"
            approve = 0
        End If
        Unload frmUSU_HelpPjlx
    Case "pjh"
        If iCol > 1 Then
            Set tmpItem = m_FzHeadCollection.Item(iCol - 1)
            If IsNumeric(cllFz.GetCellNote(iCol, iRow, 0)) Then
                If CInt(cllFz.GetCellNote(iCol, iRow, 0)) < Len(text) And CInt(cllFz.GetCellNote(iCol, iRow, 0)) > 0 Then
                    text = Left$(text, CInt(cllFz.GetCellNote(iCol, iRow, 0)))
                End If
            End If
        End If
    Case "je"
        If IsNumeric(text) Then
            cllFz.d iCol, iRow, cllFz.GetCurSheet, Format(text, "#0.00")
            If iCol > 1 Then
                Set tmpItem = m_FzHeadCollection.Item(iCol - 1)
                If tmpItem.uType = "dj" Then
                    If Abs(cllFz.GetCellDouble(iCol - 2, iRow, 0)) >= 0.0001 And Abs(cllFz.GetCellDouble(iCol - 1, iRow, 0)) < 0.001 Then
                        cllFz.SetCellDouble iCol - 1, iRow, 0, Format(cllFz.GetCellDouble(iCol, iRow, 0) / cllFz.GetCellDouble(iCol - 2, iRow, 0), "")
                    ElseIf Abs(cllFz.GetCellDouble(iCol - 1, iRow, 0)) >= 0.0001 And Abs(cllFz.GetCellDouble(iCol - 2, iRow, 0)) < 0.001 Then
                        cllFz.SetCellDouble iCol - 2, iRow, 0, Format(cllFz.GetCellDouble(iCol, iRow, 0) / cllFz.GetCellDouble(iCol - 1, iRow, 0), "")
                    End If
                End If
            End If
        End If
        OnFzJeChange iRow
    Case "sl"
        If IsNumeric(text) Then
            d = CDbl(text)
            If Abs(d) >= 10 ^ 11 Then
                MsgBox "超出最大长度！"
                approve = 0
            Else
                
                cllFz.SetCellDouble iCol + 2, iRow, 0, Format(d * cllFz.GetCellDouble(iCol + 1, iRow, 0), "")
                Set tmpItem = m_FzHeadCollection.Item(iCol + 2)
                If tmpItem.uType = "wb" Then
                    cllFz.SetCellDouble iCol + 4, iRow, 0, Format(cllFz.GetCellDouble(iCol + 2, iRow, 0) * cllFz.GetCellDouble(iCol + 3, iRow, 0), "")
                End If
                OnFzJeChange iRow
            End If
        Else
            approve = 0
        End If
    Case "dj"
        If IsNumeric(text) Then
            d = CDbl(text)
            If Abs(d) >= 10 ^ 13 Then
                MsgBox "超出最大长度！"
                approve = 0
            Else
                cllFz.SetCellDouble iCol + 1, iRow, 0, d * cllFz.GetCellDouble(iCol - 1, iRow, 0)
                Set tmpItem = m_FzHeadCollection.Item(iCol + 1)
                If tmpItem.uType = "wb" Then
                    cllFz.SetCellDouble iCol + 3, iRow, 0, Format(cllFz.GetCellDouble(iCol + 1, iRow, 0) * cllFz.GetCellDouble(iCol + 2, iRow, 0), "")
                End If
                OnFzJeChange iRow
            End If
        Else
            approve = 0
        End If
    Case "wb"
        If IsNumeric(text) Then
            d = CDbl(text)
            If Abs(d) >= 10 ^ 13 Then
                MsgBox "超出最大长度！"
                approve = 0
            Else
                If iTm.uCode = "/" Then
                    If Abs(Format(cllFz.GetCellDouble(iCol + 1, iRow, 0), "#0.00")) >= 0.01 Then
                        cllFz.SetCellDouble iCol + 2, iRow, 0, Format(d / cllFz.GetCellDouble(iCol + 1, iRow, 0), "#0.00")
                        OnFzJeChange iRow
                    End If
                Else
                    cllFz.SetCellDouble iCol + 2, iRow, 0, Format(d * cllFz.GetCellDouble(iCol + 1, iRow, 0), "#0.00")
                    OnFzJeChange iRow
                End If
            End If
        Else
            approve = 0
        End If
    Case "hl"
        If IsNumeric(text) Then
            d = CDbl(text)
            Set tmpItem = m_FzHeadCollection.Item(iCol - 1)
            If Abs(d) >= 10 ^ CInt(tmpItem.uDefault) Then
                MsgBox "超出最大长度！"
                approve = 0
            Else
                If tmpItem.uCode = "/" Then
                    If Abs(Format(d, "#0.00")) >= 0.01 Then
                        cllFz.SetCellDouble iCol + 1, iRow, 0, Format(cllFz.GetCellDouble(iCol - 1, iRow, 0) / d, "#0.00")
                        OnFzJeChange iRow
                    End If
                Else
                    cllFz.SetCellDouble iCol + 1, iRow, 0, Format(cllFz.GetCellDouble(iCol - 1, iRow, 0) * d, "#0.00")
                    OnFzJeChange iRow
                End If
            End If
        Else
            approve = 0
        End If
    End Select
    EditFzFinish iTm, sCode, sName, iRow
    Exit Sub
error:
  MsgBox "请输入正确的辅助信息！"

End Sub

'辅助信息中金额修改...
Public Function OnFzJeChange(ByVal iRow As Integer)
Dim iTm As clsFzHead
Dim i As Integer
Dim iColJe As Integer
Dim bFx As Boolean 'T借方F贷方
Dim TotalJe As Double
    i = 1
    iColJe = 0
    While i <= m_FzHeadCollection.Count
        Set iTm = m_FzHeadCollection.Item(i)
        If iTm.uType = "je" Then
            iColJe = i
        End If
        i = i + 1
    Wend
    If iColJe > 0 Then
        If Abs(cllVoucher.GetCellDouble(COL_CREDIT, cllVoucher.GetCurrentRow, 0)) < 0.005 Then
            If cllVoucher.GetCurrentCol >= COL_CREDIT And Abs(cllVoucher.GetCellDouble(COL_DEBIT, cllVoucher.GetCurrentRow, 0)) < 0.005 Then
                bFx = False
            Else
                bFx = True
            End If
        Else
            bFx = False
        End If
        i = 2
        TotalJe = 0
        While i <= cllFz.GetRows(0)
            TotalJe = TotalJe + Format(cllFz.GetCellDouble(iColJe, i, 0), "#0.00")
            i = i + 1
        Wend
        If bFx = True Then
            cllVoucher.d COL_DEBIT, cllVoucher.GetCurrentRow, cllVoucher.GetCurSheet, TotalJe
        Else
            cllVoucher.d COL_CREDIT, cllVoucher.GetCurrentRow, cllVoucher.GetCurSheet, TotalJe
        End If
        cllVoucher.Redraw
        OnVoucherJeChange
    End If
End Function

'辅助编辑完成
Public Function EditFzFinish(ByVal sITEM As clsFzHead, ByVal sCode As String, ByVal sName As String, ByVal iRow As Integer)
    SetFzFocus
    cllVoucher.Redraw
End Function

Private Sub cllFz_GotFocus()
    bFzGetFocus = True
    bVoucherGetFocus = False
End Sub

Private Sub cllFz_InputFormula(ByVal col As Long, ByVal row As Long, processed As Long)
processed = 0
End Sub

Private Sub cllFz_KeyDown(KeyCode As Integer, Shift As Integer)
Dim iCol As Integer
Dim iRow As Integer
Dim bFz As Boolean
Dim i As Integer
Dim dJf As Double
Dim dDf As Double
Dim kmdm As String
Dim approve As Long
Dim iTm As clsFzHead

'SetFzFocus
    iCol = cllFz.GetCurrentCol
    iRow = cllFz.GetCurrentRow
    SaveChangeCol
    Select Case KeyCode
    Case 187
        MakeBalance cllFz.GetCurrentRow
    Case 13
            If iCol >= cllFz.GetCols(0) - 1 And iRow >= cllFz.GetRows(0) - 1 Then
                i = 1
                bFz = False
                While i <= m_FzHeadCollection.Count
                    Set iTm = m_FzHeadCollection.Item(i)
                    Select Case iTm.uType
                    Case "xm", "bm", "gr", "gys", "kh"
                        bFz = True
                    End Select