📄 frmpurchaseorder.frm
字号:
On Error Resume Next
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
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
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
' i = clsbill.showmsgother(Me.hwnd, "您确实要删除本张已经执行的采购订单的全部分录吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, "删除单据")
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 PurchaseOrderDetail.lngPurchaseOrderDetailID AS lngDetailID " _
' & "FROM PurchaseOrder LEFT JOIN PurchaseOrderDetail ON PurchaseOrder.lngPurchaseOrderID = PurchaseOrderDetail.lngPurchaseOrderID " _
' & "WHERE PurchaseOrder.lngPurchaseOrderID=" & clsBill.lngNowID
strSql = "SELECT PurchaseOrderDetail.lngPurchaseOrderDetailID AS lngDetailID " _
& "FROM PurchaseOrder,PurchaseOrderDetail WHERE PurchaseOrder.lngPurchaseOrderID = PurchaseOrderDetail.lngPurchaseOrderID " _
& "AND PurchaseOrder.lngPurchaseOrderID=" & clsBill.lngNowID
Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If Not (recTmp.BOF And recTmp.EOF) Then
While Not recTmp.EOF
clsBill.DeleteOrderDetail recTmp(0)
recTmp.MoveNext
Wend
End If
recTmp.Close
Set recTmp = Nothing
End If
strSql = "DELETE FROM PurchaseOrder WHERE lngPurchaseOrderID=" & clsBill.lngNowID
gclsBase.ExecSQL strSql
strSql = "DELETE FROM PurchaseOrderDetail WHERE lngPurchaseOrderID=" & 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
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 11
CallBillList 1, True
Case 12
CallBillList 1, False
Case 13
GotoOldBill
Case 14
mclsMainControl_FilePrintReceipt
Case 16
If C2lng(lblHead(0).Tag) > 0 Then
CmdNote_Click
End If
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 1, !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 = IIf(IsDate(lblField(3).Caption), lblField(3).Caption, Format(gclsBase.BaseDate, "yyyy-mm-dd"))
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
' !dblReceiveQuantity = 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
!dblReceiveQuantity = 0
End If
' !dblPrice = IIf(C2Dbl(clsBill.strGrdCell(i, 34)) = 0, C2Dbl(clsBill.strGrdCell(i, 4)), C2Dbl(clsBill.strGrdCell(i, 4)) / C2Dbl(clsBill.strGrdCell(i, 34)))
' !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
!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) = !lngPurchaseOrderDetailID
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 DataValid() = False Then
Exit Function
End If
If Not clsBill.DataValid Then
Exit Function
End If
Me.MousePointer = vbHourglass
SaveStart:
gclsBase.BaseWorkSpace.BeginTrans
blnTransBegin = True
Set recActivity = gclsBase.BaseDB.Op⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -