📄 frmcashsettle.frm
字号:
strSql = "UPDATE ItemActivity SET blnIsCash=1 WHERE lngActivityID=" & mlngActivityID
End If
If gclsBase.ExecSQL(strSql) = False Then
mblnSucceed = 0
GoTo ErrH
End If
gclsBase.BaseWorkSpace.CommitTrans
gclsSys.SendMessage Me.hwnd, 30 + ReceiptType
SaveBill = True
Exit Function
ErrH:
gclsBase.BaseWorkSpace.RollBacktrans
If mstrErrMsg <> "" Then ShowMsg Me.hwnd, mstrErrMsg, MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "保存单据"
End Function
Private Function DataValid() As Boolean
Dim dblTmp As Double
If GrdCol.Rows <= 1 Then
DataValid = True
Exit Function
ElseIf GrdCol.Rows = 2 Then
If RowDatas(GrdCol.RowData(1)).lngAccountID <= 0 Then
DataValid = True
Exit Function
End If
End If
dblTmp = Round(C2Dbl(hlb(xlngColNo(7)).Caption) + C2Dbl(hlb(xlngColNo(9)).Caption), gclsBase.NaturalCurDec) - Round(C2Dbl(SubStr(lblHead(6).Caption, 11)), gclsBase.NaturalCurDec)
If dblTmp <> 0 Then
cMsgBox "本次" & mstrDoing & "金额及折扣不等于原单据金额（差额：" & Format$(dblTmp, FormatString(gclsBase.NaturalCurDec)) & "）！"
Exit Function
End If
dblTmp = Round(C2Dbl(hlb(xlngColNo(6)).Caption) + C2Dbl(hlb(xlngColNo(8)).Caption), lngCurrDec) - Round(C2Dbl(SubStr(lblHead(5).Caption, 11)), lngCurrDec)
If dblTmp <> 0 Then
cMsgBox "本次" & mstrDoing & "原币金额及折扣不等于原单据原币金额（差额：" & Format$(dblTmp, FormatString(lngCurrDec)) & "）！"
Exit Function
End If
If refHead(0).ID <= 0 Then
cMsgBox "必须输入" & mstrDoing & "单据模板！"
refHead(0).SetFocus
Exit Function
End If
If Round(C2Dbl(hlb(xlngColNo(9)).Caption), gclsBase.NaturalCurDec) <> 0 Then
If refHead(1).ID <= 0 Then
cMsgBox "折扣金额不为0时必须输入折扣模板！"
refHead(1).SetFocus
Exit Function
End If
If refHead(2).ID <= 0 Then
cMsgBox "折扣金额不为0时必须输入折扣科目！"
refHead(2).SetFocus
Exit Function
End If
End If
Dim i As Long
Dim j As Long
For i = 1 To GrdCol.Rows - 1
If RowDatas(GrdCol.RowData(i)).lngAccountID > 0 Then
RowDatas(GrdCol.RowData(i)).Account = blnOther(RowDatas(GrdCol.RowData(i)).lngAccountID)
If RowDatas(GrdCol.RowData(i)).Account.lngAccountID = 0 Then
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "不存在！"
Exit Function
ElseIf RowDatas(GrdCol.RowData(i)).Account.blnIsInActive Then
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "已停用！"
Exit Function
ElseIf RowDatas(GrdCol.RowData(i)).Account.blnIsDetail = False Then
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "不是名细科目！"
Exit Function
ElseIf RowDatas(GrdCol.RowData(i)).Account.intAccountNatureID <> 1 And RowDatas(GrdCol.RowData(i)).Account.intAccountNatureID <> 2 Then
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "不是现金银行科目！"
Exit Function
Else
End If
Dim account1 As AccountblnOther
If blnCurrencyErr(RowDatas(GrdCol.RowData(i)).lngAccountID, frmName.getFieldID(7), account1) Then
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "不能核算币种" & frmName.lblField(7).Caption & "！"
Exit Function
End If
If C2Dbl(GrdCol.TextMatrix(i, xlngColNo(7))) = 0 Then
cMsgBox "第" & i & "行本次" & mstrDoing & "金额不能为空（0）！"
Exit Function
End If
If GrdCol.TextMatrix(i, xlngColNo(1)) = "" Then
cMsgBox "第" & i & "行" & mstrDoing & "日期不能为空！"
Exit Function
ElseIf IsDate(GrdCol.TextMatrix(i, xlngColNo(1))) = False Then
cMsgBox "第" & i & "行" & mstrDoing & "日期输入错误！"
Exit Function
Else
Select Case gclsBase.PeriodClosed(GrdCol.TextMatrix(i, xlngColNo(1)))
Case 1
cMsgBox "第" & i & "行" & mstrDoing & "日期小于帐套启用日期！"
Exit Function
Case 2
cMsgBox "第" & i & "行" & mstrDoing & "日期大于帐套结束日期！"
Exit Function
Case -1
cMsgBox "第" & i & "行" & mstrDoing & "日期的会计期间已结帐！"
Exit Function
Case Else
RowDatas(GrdCol.RowData(i)).intYear = gclsBase.FYearOfDate(GrdCol.TextMatrix(i, xlngColNo(1)))
RowDatas(GrdCol.RowData(i)).bytPeriod = gclsBase.PeriodOfDate(GrdCol.TextMatrix(i, xlngColNo(1)))
End Select
End If
If RowDatas(GrdCol.RowData(i)).Account.blnIsDepartment And RowDatas(GrdCol.RowData(i)).lngDepartmentID = 0 Then
If GrdCol.ColWidth(xlngColNo(10)) = 0 Then
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "要进行部门核算，必须输入部门，请先修改" & mstrDoing & "单据模板的表头栏目使该列可见" & "！"
Else
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "要进行部门核算，必须输入部门！"
End If
Exit Function
End If
If RowDatas(GrdCol.RowData(i)).Account.blnIsEmployee And RowDatas(GrdCol.RowData(i)).lngEmployeeID = 0 Then
If GrdCol.ColWidth(xlngColNo(11)) = 0 Then
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "要进行职员核算，必须输入职员，请先修改" & mstrDoing & "单据模板的表头栏目使该列可见" & "！"
Else
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "要进行职员核算，必须输入职员！"
End If
Exit Function
End If
If RowDatas(GrdCol.RowData(i)).Account.blnIsClass1 And RowDatas(GrdCol.RowData(i)).lngClassID1 = 0 Then
If GrdCol.ColWidth(12) = 0 Then
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "要进行统计核算，必须输入统计，请先修改" & mstrDoing & "单据模板的表头栏目使该列可见" & "！"
Else
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "要进行统计核算，必须输入统计！"
End If
Exit Function
End If
If RowDatas(GrdCol.RowData(i)).Account.blnIsClass2 And RowDatas(GrdCol.RowData(i)).lngClassID2 = 0 Then
If GrdCol.ColWidth(xlngColNo(13)) = 0 Then
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "要进行项目核算，必须输入项目，请先修改" & mstrDoing & "单据模板的表头栏目使该列可见" & "！"
Else
cMsgBox "第" & i & "行科目" & GrdCol.TextMatrix(i, xlngColNo(3)) & "要进行项目核算，必须输入项目！"
End If
Exit Function
End If
If Not IsDetail(xDepartment, RowDatas(GrdCol.RowData(i)).lngDepartmentID) Then
cMsgBox "第" & i & "行部门" & GrdCol.TextMatrix(i, xlngColNo(10)) & "不是末级部门，不能存盘！"
Exit Function
End If
If Not IsDetail(xCLASS1, RowDatas(GrdCol.RowData(i)).lngClassID1) Then
cMsgBox "第" & i & "行统计" & GrdCol.TextMatrix(i, xlngColNo(12)) & "不是末级统计，不能存盘！"
Exit Function
End If
If Not IsDetail(xClass2, RowDatas(GrdCol.RowData(i)).lngClassID2) Then
cMsgBox "第" & i & "行项目" & GrdCol.TextMatrix(i, xlngColNo(13)) & "不是末级项目，不能存盘！"
Exit Function
End If
'单据号判断--------------------------
If Trim(GrdCol.TextMatrix(i, xlngColNo(2))) = "" Then
cMsgBox "第" & i & "行单据号为必输项，不能存盘！"
Exit Function
End If
If C2lng(BillPublic.strDigitOfStr(GrdCol.TextMatrix(i, xlngColNo(2)))) = 0 Then
cMsgBox "第" & i & "行单据号输入非法，不能存盘！"
Exit Function
End If
For j = 1 To i - 1
If RowDatas(GrdCol.RowData(j)).intYear = RowDatas(GrdCol.RowData(i)).intYear And RowDatas(GrdCol.RowData(j)).bytPeriod = RowDatas(GrdCol.RowData(i)).bytPeriod And GrdCol.TextMatrix(j, xlngColNo(2)) = GrdCol.TextMatrix(i, xlngColNo(2)) Then
cMsgBox "第" & i & "行与第" & j & "单据号重复，不能存盘！"
Exit Function
End If
If gclsBase.NoOrder Then
If C2Date(GrdCol.TextMatrix(j, xlngColNo(1))) > C2Date(GrdCol.TextMatrix(i, xlngColNo(1))) _
And strAlphaOfStr(GrdCol.TextMatrix(j, xlngColNo(2))) = strAlphaOfStr(GrdCol.TextMatrix(i, xlngColNo(2))) _
And C2lng(strDigitOfStr(GrdCol.TextMatrix(j, xlngColNo(2)))) < C2lng(strDigitOfStr(GrdCol.TextMatrix(i, xlngColNo(2)))) Then
cMsgBox "第" & j & "行在日期" & GrdCol.TextMatrix(j, xlngColNo(1)) & "已有编号为" & GrdCol.TextMatrix(j, xlngColNo(2)) & "的单据，比当前编号" & GrdCol.TextMatrix(i, xlngColNo(2)) & "小，在第" & i & "行日期" & GrdCol.TextMatrix(i, xlngColNo(1)) & "只能选用更小的编号。"
Exit Function
ElseIf C2Date(GrdCol.TextMatrix(j, xlngColNo(1))) < C2Date(GrdCol.TextMatrix(i, xlngColNo(1))) _
And strAlphaOfStr(GrdCol.TextMatrix(j, xlngColNo(2))) = strAlphaOfStr(GrdCol.TextMatrix(i, xlngColNo(2))) _
And C2lng(strDigitOfStr(GrdCol.TextMatrix(j, xlngColNo(2)))) > C2lng(strDigitOfStr(GrdCol.TextMatrix(i, xlngColNo(2)))) Then
cMsgBox "第" & j & "行在日期" & GrdCol.TextMatrix(j, xlngColNo(1)) & "已有编号为" & GrdCol.TextMatrix(j, xlngColNo(2)) & "的单据，比当前编号" & GrdCol.TextMatrix(i, xlngColNo(2)) & "大，在第" & i & "行日期" & GrdCol.TextMatrix(i, xlngColNo(1)) & "只能选用更大的编号。"
Exit Function
End If
End If
Next
If blnReceiptNoRepeat(GrdCol.TextMatrix(i, xlngColNo(1)), ReceiptType, GrdCol.TextMatrix(i, xlngColNo(2)), RowDatas(GrdCol.RowData(i)).lngActivityID) Then
cMsgBox "第" & i & "行单据号重复，不能存盘！"
Exit Function
End If
If ReceiptNOIsOk(Me, GrdCol.TextMatrix(i, xlngColNo(1)), ReceiptType, strAlphaOfStr(GrdCol.TextMatrix(i, xlngColNo(2))), strDigitOfStr(GrdCol.TextMatrix(i, xlngColNo(2))), RowDatas(GrdCol.RowData(i)).lngActivityID) <> 0 Then
Exit Function
End If
Else
If GrdCol.TextMatrix(i, xlngColNo(1)) <> "" Or GrdCol.TextMatrix(i, xlngColNo(2)) <> "" Or GrdCol.TextMatrix(i, xlngColNo(6)) <> "" Or GrdCol.TextMatrix(i, xlngColNo(8)) <> "" Then
cMsgBox "第" & i & "行科目为必输项，不能存盘！"
Exit Function
End If
End If
Next
DataValid = True
End Function
Private Sub SaveActivity(recTmp As rdoResultset, ByVal RowNo As Long)
With recTmp
!lngActivityTypeID = IIf(mlngReceiptTypeID < 12, 39, 40)
!lngReceiptTypeID = !lngActivityTypeID
!lngTemplateID = refHead(0).ID
!intYear = gclsBase.FYearOfDate(GrdCol.TextMatrix(RowNo, xlngColNo(1)))
!bytPeriod = gclsBase.PeriodOfDate(C2Date(GrdCol.TextMatrix(RowNo, xlngColNo(1))))
!strReceiptNo = strRight1(BillPublic.strAlphaOfStr(GrdCol.TextMatrix(RowNo, xlngColNo(2))), 6)
If !strReceiptNo = "" Then !strReceiptNo = " "
!lngReceiptNo = C2lng(BillPublic.strDigitOfStr(GrdCol.TextMatrix(RowNo, xlngColNo(2))))
!strDate = Format$(GrdCol.TextMatrix(RowNo, xlngColNo(1)), "yyyy-mm-dd")
!lngPaymentMethodID = GetGridRefID("PaymentMethod", RowNo)
!strCheckNumber = IIf(GrdCol.TextMatrix(RowNo, xlngColNo(5)) = "", " ", strLeft1(GrdCol.TextMatrix(RowNo, xlngColNo(5)), 20))
!lngOperatorID = gclsBase.OperatorID ' gclsBase.OperatorID
!lngSourceActivityID = 0 '冲销单据的来源单据ID
!blnIsPrint = IIf(frmName.chkPrint(0).Value = 0, 0, 1) 'False
!blnIsVoid = 0
If mlngReceiptTypeID >= 12 Then
!strDebitAccountCode = strAccountCode(False, RowNo)
!strCreditAccountCode = strAccountCode(True, RowNo)
Else
!strDebitAccountCode = strAccountCode(True, RowNo)
!strCreditAccountCode = strAccountCode(False, RowNo)
End If
!blnIsSpecial = 1
!lngItemActivityID = mlngActivityID
End With
End Sub
Private Sub SaveActivityDetailHead(recTmp As rdoResultset, ByVal RowNo As Long)
With recTmp
!lngCustomerID = C2lng(frmName.lblHead(1 - 1).Tag)
' !strRemark = strLeft1(LblMemo(1).Caption + " ", 40)
!lngEmployeeID = GetGridRefID("Employee", RowNo)
!lngDepartmentID = GetGridRefID("Department", RowNo)
!lngAccountID = GetGridRefID("Account", RowNo)
!lngClassID2 = GetGridRefID("Class2", RowNo)
!lngClassID1 = GetGridRefID("Class1", RowNo)
!dblCurrAmount = C2Dbl(GrdCol.TextMatrix(RowNo, xlngColNo(6)))
!dblAmount = C2Dbl(GrdCol.TextMatrix(RowNo, xlngColNo(7)))
!dblRate = C2Dbl(frmName.lblField(6).Caption)
!lngCurrencyID = frmName.getFieldID(7)
!blnIsReceipt = 1
'处理银行存款的关闭标志
' If blnIsClosed Then
' If clsBill.blnChangeClose(lngOldAccountID, lngOldCurrencyID, strOldCurrAmount, strOldAmount, strOldRate) Then
' !blnIsClosed = False
' End If
' End If
Dim strSql As String
If mlngReceiptTypeID < 12 Then
If GetGridRefID("Check", RowNo) = 1 And Trim(GrdCol.TextMatrix(RowNo, xlngColNo(5))) <> "" Then
'修改支票领用报销明细
strSql = "UPDATE CheckDetail SET blnIsUsed=1,strUseDate='" & Format$(GrdCol.TextMatrix(RowNo, xlngColNo(1)), "YYYY-MM-DD") & "'" & _
",dblCurrAmount=" & !dblCurrAmount & _
",lngVoucherDetailID= " & -!lngActivityDetailID & _
" WHERE lngAccountID=" & !lngAccountID & _
" AND lngCurrencyID=" & !lngCurrencyID & _
" AND lngPaymentMethodID=" & GetGridRefID("PaymentMethod", RowNo) & _
" AND strCheckNo='" & Trim(GrdCol.TextMatrix(RowNo, xlngColNo(5))) & "'"
If gclsBase.ExecSQL(strSql) = False Then
Err.Raise 10
End If
End If
End If
End With
End Sub
Private Sub SaveActivityDetailBody(recTmp As rdoResultset, ByVal RowNo As Long)
Dim dblTmp As Double
With recTmp
!strRemark = frmName.lblHead(3).Caption
!dblCurrAmount = C2Dbl(GrdCol.TextMatrix(RowNo, xlngColNo(6)))
!dblAmount = C2Dbl(GrdCol.TextMatrix(RowNo, xlngColNo(7)))
!dblCurrPaymentAmount = !dblCurrAmount
!dblRate = C2Dbl(frmName.lblField(6).Caption)
!lngCurrencyID = frmName.getFieldID(7)
' !dblQuantity = dblQuantity 'NumberConvert(clsBill.strGrdCell(i, 20), C2Dbl(TextMatrix(i, 35)), True)
' If dblQuantity <> 0 Then
' !dblCurrPrice = IIf(dblQuantity <> 0, dblCurrAmount / dblQuantity, 0) 'IIf( <> 0, C2Dbl(clsBill.strGrdCell(i, 6)) / C2Dbl(clsBill.strGrdCell(i, 19)), 0)
' Else
' !dblCurrPrice = 0 'IIf( <> 0, C2Dbl(clsBill.strGrdCell(i, 6)) / C2Dbl(clsBill.strGrdCell(i, 19)), 0)
' End If
!lngAccountID = frmName.getFieldID(5)
!lngCustomerID = C2lng(frmName.lblHead(1 - 1).Tag)
!lngDepartmentID = frmName.getFieldID(4)
!lngEmployeeID = frmName.getFieldID(3)
!lngClassID1 = frmName.getFieldID(9)
!lngClassID2 = frmName.getFieldID(8)
!lngRowID = 1
!blnIsReceipt = 0
'设已存储标志
End With
End Sub
Private Function SaveNewBill(ByVal RowNo As Long) As Boolean
Dim recActivity As rdoResultset
Dim lngNewActivityID As Long
Dim lngDiscountID As Long
Dim dtmDate1 As Date
Dim i As Long
Dim intRow As Integer
Dim blnTrans As Boolean
Dim strSql As String
Dim dblQ As Double
Dim intAdd As Integer
Dim lngTmp As Long
If ReceiptType = 39 Then '应付
intAdd = -1
Else
intAdd = 1
End If
' '----------先确定此单据类型所对应的借贷方向------------------------
' Call ReceiptTypeToFieldIsDebit(ReceiptType)
' '------------------------------------------------------------------
On Error GoTo ErrorHandle
StartSaveBill:
Set recActivity = gclsBase.BaseDB.OpenResultset( _
"SELECT * FROM Activity WHERE lngActivityID=0", rdOpenDynamic, rdConcurValues)
If recActivity Is Nothing Then
GoTo EndProc
End If
With recActivity
.AddNew
!lngActivityID = GetNewID("Activity")
lngNewActivityID = !lngActivityID
SaveActivity recActivity, RowNo
.Update
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -