📄 frmsaleorder.frm
字号:
SetHelpID Me.HelpContextID
Dim strMsg(5) As String, strMsg1(5) As String
Dim intYesNo As Integer
Dim i%, j%
strMsg(0) = "您确实要删除全部销售订单的分录吗？"
strMsg(1) = "您确实要删除全部已经作废销售订单的分录吗？"
strMsg(2) = "您确实要删除全部已经关闭销售订单的分录吗？"
strMsg(2) = "您确实要删除全部已经执行销售订单的分录吗？"
strMsg1(0) = "您确实要删除该条销售订单的分录吗？"
strMsg1(1) = "您确实要删除该条已经作废销售订单的分录吗？"
strMsg1(2) = "您确实要删除该条已经关闭销售订单的分录吗？"
strMsg1(3) = "该条销售订单的分录已经执行，不能删除！"
Select Case intIndex
Case 0 '插入记录
If Not clsBill.SaveInput2Form() Then
Exit Sub
End If
clsBill.InsertARow
GrdCol.col = 1
clsBill.grdCol_EnterCell
Case 1 '删除记录
If clsBill.rowIsDone(GrdCol.Row) Then
clsBill.ShowMsgOther Me.hwnd, strMsg1(3), MB_OK + MB_ICONEXCLAMATION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录"
Exit Sub
End If
If chkPrint(1).Value = 1 Then
intYesNo = clsBill.ShowMsgOther(Me.hwnd, strMsg1(1), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录")
ElseIf GrdCol.TextMatrix(GrdCol.Row, 12) <> "" Then
intYesNo = clsBill.ShowMsgOther(Me.hwnd, strMsg1(2), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录")
Else
intYesNo = clsBill.ShowMsgOther(Me.hwnd, strMsg1(0), MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "删除分录")
End If
If intYesNo = IDYES Then
clsBill.blnCtrlBinding = False
' If Not clsBill.blnDeleteARow(grdCol.Row) Then
' clsbill.showmsgother Me.hwnd, "删除当前记录失败！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "删除分录"
' Exit Sub
' End If
If GrdCol.Row >= 1 And GrdCol.Rows > 2 Then
clsBill.blnDeleteARow GrdCol.Row
GrdCol.RemoveItem GrdCol.Row
clsBill.setAllItemproperty
If clsBill.rowIsDone(GrdCol.Row) Then
If GrdCol.col = 1 Then
GrdCol.col = 2
End If
Else
GrdCol.col = 1
End If
ElseIf GrdCol.Row = 1 Then
clsBill.blnDeleteARow GrdCol.Row
GrdCol.Rows = 1
clsBill.InsertARow False
GrdCol.Row = 1
GrdCol.col = 1
clsBill.setAllItemproperty
End If
clsBill.blnIsChanged = True
clsBill.blnCtrlBinding = True
clsBill.InputCtrInvisible
clsBill.grdCol_EnterCell
clsBill.BuildNoteMsg True
End If
Case 2 'bar
Case 3 '复制记录
clsBill.CopyARow
Case 4 '粘贴记录
clsBill.PasteARow
Case 5 'Bar
Case 6 '搜索
frmTreeFind.ShowFind
Case 7 '查询缺号
Dim frmTmp As Form
Set frmTmp = New frmBillNo
frmTmp.ShowTypeID C2lng(lblHead(2).Tag)
Set frmTmp = Nothing
End Select
'合计行计算
clsBill.WriteTotal
End Sub
Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
Dim dtmDate1 As Date
Select Case intIndex
Case 0 '插入单据
' clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(2).Caption
If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then
Exit Sub
End If
ShowANewBill
Case 1 '删除单据
If clsBill.lngNowID = 0 And clsBill.blnIsChanged = False Then
Exit Sub
End If
If chkPrint(2).Value = 1 Then
clsBill.ShowMsgOther Me.hwnd, "本张销售订单已关闭，不能删除！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "删除单据"
Exit Sub
End If
If clsBill.blnIsPrinted Then
If clsBill.blnModifyPrintedBill Then
If clsBill.ShowMsgOther(Me.hwnd, "本张" & lblCaption.Caption & "已经打印，您确实要删除吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "删除单据") = vbNo Then
Exit Sub
End If
Else
clsBill.ShowMsgOther Me.hwnd, "本张" & lblCaption.Caption & "已经打印，不能删除！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "删除单据"
Exit Sub
End If
End If
If clsBill.lngNowID <> 0 Then
Dim recTmp As rdoResultset
Dim i As Integer
For i = 1 To GrdCol.Rows - 1
If clsBill.rowIsDone(i) Then Exit For
Next
If i = GrdCol.Rows Then
i = clsBill.ShowMsgOther(Me.hwnd, "您确实要删除本张销售订单的全部分录吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "删除单据")
Else
If clsBill.ShowMsgOther(Me.hwnd, "本张销售订单已经执行，您确实要删除吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL, "删除单据") = vbNo Then
Exit Sub
End If
End If
If i = vbNo Then Exit Sub
On Error GoTo errhandle1
gclsBase.BaseWorkSpace.BeginTrans
If chkPrint(1).Value <> 1 Then
' strSql = "SELECT SaleOrderDetail.lngSaleOrderDetailID AS lngDetailID " _
' & "FROM SaleOrder LEFT JOIN SaleOrderDetail ON SaleOrder.lngSaleOrderID = SaleOrderDetail.lngSaleOrderID " _
' & "WHERE SaleOrder.lngSaleOrderID=" & clsBill.lngNowID
strSql = "SELECT SaleOrderDetail.lngSaleOrderDetailID AS lngDetailID " _
& "FROM SaleOrder,SaleOrderDetail WHERE SaleOrder.lngSaleOrderID = SaleOrderDetail.lngSaleOrderID " _
& "AND SaleOrder.lngSaleOrderID=" & clsBill.lngNowID
Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If Not (recTmp.BOF And recTmp.EOF) Then
While Not recTmp.EOF
clsBill.DeleteOrderDetail recTmp!lngDetailID
recTmp.MoveNext
Wend
End If
recTmp.Close
Set recTmp = Nothing
End If
strSql = "DELETE FROM SaleOrder WHERE lngSaleOrderID=" & clsBill.lngNowID
gclsBase.ExecSQL strSql
strSql = "DELETE FROM SaleOrderDetail WHERE lngSaleOrderID=" & clsBill.lngNowID
gclsBase.ExecSQL strSql
dtmDate1 = C2Date(lblField(3).Caption)
' clsBill.intAccountYear = gclsBase.FYearOfDate(dtmDate1) '会计年度
' clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(dtmDate1) '会计期间
blnMaxNODecrease gclsBase.FYearOfDate(NewReceiptDate), gclsBase.PeriodOfDate(NewReceiptDate), C2lng(lblHead(2).Tag), _
SubStr(strAlphaOfStr(LTrim(strNewReceiptNO)), 1, 6), _
strDigitOfStr(LTrim(strNewReceiptNO))
' strNewReceiptNO = lblField(2).Caption
' NewReceiptDate = gclsBase.BaseDate
' blnModifyMaxNO gclsBase.FYearOfDate(NewReceiptDate), gclsBase.PeriodOfDate(NewReceiptDate), C2lng(lblHead(2).Tag), _
' SubStr(strAlphaOfStr(LTrim(strNewReceiptNO)), 1, 6), _
' strDigitOfStr(LTrim(strNewReceiptNO))
gclsBase.BaseWorkSpace.CommitTrans
gclsSys.SendMessage Me.hwnd, 30 + C2lng(lblHead(2).Tag)
'' clsBill.lngNowID = 0
clsBill.blnIsChanged = False
clsBill.lngNowID = 0
cmdNext_Click
' ShowANewBill , False
Exit Sub
errhandle1:
gclsBase.BaseWorkSpace.RollBacktrans
' clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(2).Caption ShowANewBill
Else
If clsBill.ShowMsgOther(Me.hwnd, "您确实要删除本张销售订单的全部分录吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "删除单据") = vbYes Then
' clsBill.GetANewBill lblHead(5 - 1).Tag, lblHead(3 - 1).Tag, lblField(2).Caption
dtmDate1 = C2Date(lblField(3).Caption)
' clsBill.intAccountYear = gclsBase.FYearOfDate(dtmDate1) '会计年度
' clsBill.bytAccountPeriod = gclsBase.PeriodOfDate(dtmDate1) '会计期间
blnMaxNODecrease gclsBase.FYearOfDate(NewReceiptDate), gclsBase.PeriodOfDate(NewReceiptDate), C2lng(lblHead(2).Tag), _
SubStr(strAlphaOfStr(LTrim(strNewReceiptNO)), 1, 6), _
strDigitOfStr(LTrim(strNewReceiptNO))
strNewReceiptNO = lblField(2).Caption
NewReceiptDate = gclsBase.BaseDate
blnModifyMaxNO gclsBase.FYearOfDate(NewReceiptDate), gclsBase.PeriodOfDate(NewReceiptDate), C2lng(lblHead(2).Tag), _
SubStr(strAlphaOfStr(LTrim(strNewReceiptNO)), 1, 6), _
strDigitOfStr(LTrim(strNewReceiptNO))
clsBill.lngNowID = 0
clsBill.blnIsChanged = False
ShowANewBill , False
End If
End If
Case 2 'BAR
Case 3 '复制单据
clsBill.SaveBillToCollection
Case 4 '粘贴单据
clsBill.LoadBillFromCollection
Case 5 'BAR
Case 6 '搜索
frmTreeFind.ShowFind
Case 7 '查询单据缺号
Dim frmTmp As Form
Set frmTmp = New frmBillNo
frmTmp.ShowTypeID C2lng(lblHead(2).Tag)
Set frmTmp = Nothing
Case 9 '模板表体列宽恢复
ModifyColWidthDefault Me
clsBill.TemplateChange C2lng(lblHead(4).Tag)
Case 10 '自动报警
m_blnAlertMenuChecked = Not m_blnAlertMenuChecked
SetAlertStatus C2lng(lblHead(2).Tag), m_blnAlertMenuChecked
Case 12
CallBillList 12, True
Case 13
CallBillList 12, False
Case 14
GotoOldBill
Case 15
mclsMainControl_FilePrintReceipt
Case 17
CmdNote_Click
Case 18
clsBill.ShowCalcDisc
End Select
'合计行计算
clsBill.WriteTotal
End Sub
Private Sub refTmpID_Change()
clsBill.TemplateChange C2lng(lblHead(4).Tag)
End Sub
Private Sub SaveActivity(recTmp As rdoResultset)
Dim strTmp As String
With recTmp
!blnIsPrinted = 0
!intYear = gclsBase.FYearOfDate(C2Date(lblField(3).Caption))
!bytPeriod = gclsBase.PeriodOfDate(C2Date(lblField(3).Caption))
strTmp = SubStr(BillPublic.strAlphaOfStr(LTrim(lblField(2).Caption)), 1, 6) '文本,销售订单编号
strTmp = IIf(strTmp = "", " ", strTmp)
!strReceiptNo = strTmp
!lngReceiptNo = C2lng(BillPublic.strDigitOfStr(LTrim(lblField(2).Caption))) '数字,销售订单编号
!lngClassID2 = clsBill.getFieldID(6) '统计（项目）ID
!lngClassID1 = clsBill.getFieldID(7) '统计ID
!lngTemplateID = C2lng(lblHead(5 - 1).Tag) '数字,模版ID
BillPublic.setPrevPlateAndBillNo 12, !lngTemplateID, !strReceiptNo
!lngCustomerID = C2lng(lblHead(0).Tag)
!lngCustomerAddressID = C2lng(lblTitle(0).Tag) '单位地址ID
' !lngBusinessAddressID = C2Lng(lblTitle(2).Tag) '企业地址ID
!lngDepartmentID = clsBill.getFieldID(5)
!lngEmployeeID = clsBill.getFieldID(4)
!lngTermID = clsBill.getFieldID(12)
strTmp = lblField(11).Caption
strTmp = IIf(strTmp = "", " ", strTmp)
!strReceiptDate = strTmp
strTmp = lblField(10).Caption
strTmp = IIf(strTmp = "", " ", strTmp)
!strDueDate = strTmp
strTmp = lblField(3).Caption
strTmp = IIf(strTmp = "", " ", strTmp)
!strDate = strTmp
!lngOperatorID = IIf(C2lng(LblMemo(LblMemo.Count - 1).Tag) > 0, C2lng(LblMemo(LblMemo.Count - 1).Tag), gclsBase.OperatorID)
!lngCurrencyID = clsBill.getFieldID(9)
!dblRate = C2Dbl(lblField(8).Caption)
Dim strT As String
strT = Trim(LblMemo(1).Caption)
strTmp = IIf(StrLen(strT) < 40, strT, SubStr(strT, 1, 40)) '文本,备注
strTmp = IIf(strTmp = "", " ", strTmp)
!strNote = strTmp
!blnIsPrint = chkPrint(0).Value '是/否,打印标志
' !blnIsVoid = IIf(chkPrint(1).Value = 0, False, True) '是/否,作废标志
If chkPrint(1).Value = 1 Then
!blnIsVoid = 1
' !dblSendQuantity = 0
Else
!blnIsVoid = 0
End If
End With
End Sub
Private Sub SaveActivityDetailBody(recTmp As rdoResultset, ByVal i As Integer)
Dim strTmp As String
With recTmp
!lngRowID = i
!lngItemID = C2lng(clsBill.strGrdCell(i, 24)) '商品ID
!lngUnitID = C2lng(clsBill.strGrdCell(i, 25)) '计量单位ID
' !dblQuantity = C2Dbl(clsBill.strGrdCell(i, 35))
!dblQuantity = C2Dbl(NumberConvert(GrdCol.TextMatrix(i, 3), C2Dbl(GrdCol.TextMatrix(i, 34)), True))
If chkPrint(1).Value = 1 Then
!dblSendQuantity = 0
End If
' !dblPrice = C2Dbl(clsBill.strGrdCell(i, 4)) / ConvertFactor(!lngUnitID, !lngItemID)
!dblDiscountRate = C2Dbl(clsBill.strGrdCell(i, 6))
!dblCurrAmount = C2Dbl(clsBill.strGrdCell(i, 7))
' If !dblQuantity <> 0 Then
' !dblPrice = !dblCurrAmount * 100 / (!dblQuantity * !dblDiscountRate)
' Else
Dim dblFactor As Double
dblFactor = ConvertFactor(!lngUnitID, !lngItemID)
!dblPrice = C2Dbl(clsBill.strGrdCell(i, 4)) / dblFactor
!dblPriceTax = C2Dbl(clsBill.strGrdCell(i, 5)) / dblFactor
' End If
!dblAmount = C2Dbl(clsBill.strGrdCell(i, 8))
!lngTaxID = C2lng(clsBill.strGrdCell(i, 26))
!dblCurrTaxAmount = C2Dbl(clsBill.strGrdCell(i, 14))
!dblTaxAmount = C2Dbl(clsBill.strGrdCell(i, 15))
strTmp = clsBill.strGrdCell(i, 16)
strTmp = IIf(strTmp = "", " ", strTmp)
!strPromiseDate = strTmp
' !strPromiseDate = "1998-07-31"
!lngJobID = C2lng(clsBill.strGrdCell(i, 27))
!lngCustomID0 = C2lng(clsBill.strGrdCell(i, 28))
!lngCustomID1 = C2lng(clsBill.strGrdCell(i, 29))
!lngCustomID2 = C2lng(clsBill.strGrdCell(i, 30))
!lngCustomID3 = C2lng(clsBill.strGrdCell(i, 31))
!lngCustomID4 = C2lng(clsBill.strGrdCell(i, 32))
!lngCustomID5 = C2lng(clsBill.strGrdCell(i, 33))
!blnIsClose = IIf(clsBill.strGrdCell(i, 12) = "", 0, 1)
'设已存储标志
GrdCol.TextMatrix(i, 0) = !lngSaleOrderDetailID
' strSql = "UPDATE Item SET dblSOQuantity=dblSOQuantity + " & !dblQuantity & " WHERE lngItemid=" & !lngItemID
' gclsBase.BaseDB.Execute strSql
Dim dblRate As Double
If blnCurrencyInDirect(clsBill.getFieldID(9)) Then
dblRate = 1 / C2Dbl(lblField(8).Caption)
Else
dblRate = C2Dbl(lblField(8).Caption)
End If
clsBill.setMaxItemProperty i, !dblPrice * dblRate, !dblPriceTax * dblRate
End With
End Sub
Private Function SaveNewBill() As Boolean
Dim recActivity As rdoResultset
Dim recDetail As rdoResultset
Dim lngNewActivityID As Long
Dim dtmDate1 As Date
Dim strAlpha As String
Dim lngDigit As Long
Dim i As Long
Dim blnTransBegin As Boolean '错误处理中是否作事务回滚标志
Dim strTmp As String
SaveNewBill = False
Dim recTemp As rdoResultset
'制单日合法性校验
' If gclsBase.PeriodClosed(lblField(3).Caption) Then
' clsBill.ShowMsgOther Me.hwnd, "制单日不能在已结帐期间内！", MB_ICONEXCLAMATION + MB_OK + MB_SYSTEMMODAL, "保存单据"
' lblField(3).Caption = Format(gclsBase.BaseDate, "yyyy-mm-dd")
' SaveNewBill = False
' Exit Function
' End If
#If conDebug Then
#Else
On Error GoTo ErrorHandle
#End If
If Not clsBill.DataValid Then
Exit Function
End If
Me.MousePoin⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -