📄 frmdlselectallpurchasereceipt.frm
字号:
Unload Me
End Sub
'从对应视图取SQL语句并打开、初始化之
Private Sub GetList()
Dim sqlselect As String, strSql As String, strSelect As String, str As String
Dim strWhere As String, pbsql As String, strFrom As String
Dim recRecordset As rdoResultset, intCount As Integer
Dim q2 As QueryDef
On Error GoTo Err
mclsGrid.ListSet.ViewId = intViewID
With msgGrid
.Redraw = False
.FixedCols = 0
End With
strWhere = ""
str = ""
strSql = ""
strFrom = ""
pbsql = ""
With mclsGrid.ListSet
strFrom = .FromOfSql
pbsql = .SelectOfSql
strWhere = .WhereOfSql
End With
'str = " WHERE (((PurchaseOrderDetail.blnIsClose)=False) AND ((PurchaseOrder.lngCustomerID)=[CustomerID]) AND ((PurchaseOrder.lngCurrencyID)=[CurrencyID]) AND ((PurchaseOrderDetail.dblQuantity)>[PurchaseOrderDetail].[dblReceiveQuantity]))"
str = " WHERE (((PurchaseOrderDetail.blnIsClose)=False) And ((PurchaseOrder.blnIsVoid)=False) AND " & IIf(blnIsPurchase = True, "item.blnisBorrow=True", "blnisBorrow=False") & " AND ((PurchaseOrder.lngCustomerID)=[CustomerID]) AND ((PurchaseOrder.lngCurrencyID)=[CurrencyID]) AND ((PurchaseOrderDetail.dblQuantity)>[PurchaseOrderDetail].[dblReceiveQuantity]))"
If Len(Trim(strWhere)) >= 1 Then str = str & "AND" & " ( " & strWhere & ")"
strSql = strFrom & str
sqlselect = " Select PurchaseOrderDetail.lngPurchaseOrderDetailID As 业务ID, iif(dblReceiveQuantity<>0,'','') As 选择, " _
& " Trim(Str(Int([dblReceiveQuantity]/[dblFactor])))+'.'+String(Len(Trim(Str([dblFactor])))-Len(Trim(Str([dblReceiveQuantity] Mod " _
& " [dblFactor]))),'0')+Trim(Str([dblReceiveQuantity] Mod [dblFactor])) AS 原采购数量, dblCurrAmount+dblCurrTaxAmount AS 原采购金额, " _
& " Trim(Str(Int(([dblQuantity]-[dblReceiveQuantity])/[dblFactor])))+'.'+String(Len(Trim(Str([dblFactor])))-Len(Trim(Str(([dblQuantity]-" _
& " [dblReceiveQuantity]) Mod [dblFactor]))),'0')+Trim(Str(([dblQuantity]-[dblReceiveQuantity]) Mod [dblFactor])) AS 原未到数量, " _
& " (format((dblCurrAmount+dblCurrTaxAmount-[dblReceiveQuantity]*[dblPrice]*[dblFactor]*(1+iif(isnull(Tax.dblPurchaseTaxRate),0,Tax.dblPurchaseTaxRate/100))),'###.00')) AS 原未到金额, (PurchaseOrder.strReceiptNO & PurchaseOrder.lngReceiptNO) AS 原采购单号," _
& " lngClassID1 As 7,lngClassID2 As 8,PurchaseOrderDetail.lngItemID As 9,PurchaseOrderDetail.lngUnitID As 10,dblDiscountRate As 11,dblPrice*dblFactor As 12,PurchaseOrderDetail.lngTaxID As 13," _
& " PurchaseOrderDetail.lngJobID As 14,PurchaseOrderDetail.lngCustomID0,PurchaseOrderDetail.lngCustomID1,PurchaseOrderDetail.lngCustomID2,PurchaseOrderDetail.lngCustomID3," _
& " PurchaseOrderDetail.lngCustomID4,PurchaseOrderDetail.lngCustomID5,strReceiptNO & ' ' As 21,strReceiptNO & ' ' & Format(lngReceiptNO, '0000') As 22,dblFactor As 23," _
& " (strItemCode & ' ' & strItemName & ' ' & strItemStyle) As 24,strUnitName As 25,strTaxName As 26,Item.lngPositionID As 27,strPositionName As 28," _
& " strJobName As 29,Custom0.strCustomName As 30,Custom1.strCustomName As 31,Custom2.strCustomName As 32,Custom3.strCustomName As 33,Custom4.strCustomName As 34," _
& " Custom5.strCustomName As 35, " & pbsql
strSql = sqlselect & strSql
Set q2 = gclsBase.BaseDB.CreateQueryDef("", strSql)
q2.Parameters("CustomerID") = CustomerID
q2.Parameters("CurrencyID") = CurrencyID
Set recRecordset = q2.OpenRecordset(dbOpenSnapshot)
If (recRecordset.EOF And recRecordset.BOF) Then
isinit = False
Else
recRecordset.MoveLast
End If
Set Datadl.Recordset = recRecordset
' '列表是否为空
msgGrid.HighLight = flexHighlightAlways
recRecordset.Close
'
' With msgGrid
' .SelectionMode = flexSelectionFree
' .FocusRect = flexFocusNone
' .ColWidth(0) = 0
' .ColWidth(1) = 488
' intCount = 2
' While intCount <= 35
' .ColWidth(intCount) = 0
' intCount = intCount + 1
' Wend
' .Redraw = True
'
' End With
Exit Sub
Err:
ShowMsg Me.hwnd, "选择采购订单程序初始化失败！ ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
End Sub
'结算内容筛选
Private Sub FilterData()
Dim i As Integer
End Sub
'存盘
Private Sub SaveData(kkk As Integer) '存盘
Dim i As Integer, j As Integer, temp As Double, strSql As String
Dim l As Integer, n As Integer, slh As String, m As Integer, intCount As Integer, k As Integer
Dim blnColse As Boolean
'On Error GoTo Err
'i = 1
Me.MousePointer = vbHourglass
l = intfixl
n = intfixl
m = intfixl
While (msgGrid.TextMatrix(0, m) <> "关闭")
m = m + 1
Wend
While (msgGrid.TextMatrix(0, l) <> "未到金额")
l = l + 1
Wend
While (msgGrid.TextMatrix(0, n) <> "未到数量")
n = n + 1
Wend
intCount = ToFormName.grdCol.Rows
If ToFormName.grdCol.Rows < 2 Then
ToFormName.InsertARow
'False
intCount = intCount + 1
End If
' j = 1
' Do While j < ToFormName.grdCol.Rows '=0为未覆盖标志
' ToFormName.grdCol.TextMatrix(j, 41) = "0"
' j = j + 1
' Loop
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' 关于以下每一行的注释请参阅选择采购订单——frmdlSelectPurchaseReceipt ' '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
j = 1
While j < msgGrid.Rows
If (msgGrid.TextMatrix(j, 1) = "√") Then '前后有否变化
k = 1
Do While k < intCount
If (msgGrid.TextMatrix(j, 0) = ToFormName.grdCol.TextMatrix(k, 29)) Then
Exit Do
End If
k = k + 1
Loop
If k >= intCount Then '该订单商品是否为添加
If C2Lng(ToFormName.grdCol.TextMatrix(ToFormName.grdCol.Rows - 1, 28)) <> 0 Then
ToFormName.InsertARow
'False
End If
i = ToFormName.grdCol.Rows - 1
ToFormName.grdCol.TextMatrix(i, 1) = msgGrid.TextMatrix(j, 24)
ToFormName.grdCol.TextMatrix(i, 28) = msgGrid.TextMatrix(j, 9)
ToFormName.grdCol.TextMatrix(i, 2) = msgGrid.TextMatrix(j, 22)
ToFormName.grdCol.TextMatrix(i, 29) = msgGrid.TextMatrix(j, 0)
ToFormName.grdCol.TextMatrix(i, 3) = msgGrid.TextMatrix(j, 28)
ToFormName.grdCol.TextMatrix(i, 30) = msgGrid.TextMatrix(j, 27)
ToFormName.grdCol.TextMatrix(i, 4) = msgGrid.TextMatrix(j, 25)
ToFormName.grdCol.TextMatrix(i, 31) = msgGrid.TextMatrix(j, 10)
ToFormName.grdCol.TextMatrix(i, 5) = msgGrid.TextMatrix(j, n)
ToFormName.grdCol.TextMatrix(i, 6) = msgGrid.TextMatrix(j, 12)
ToFormName.grdCol.TextMatrix(i, 14) = msgGrid.TextMatrix(j, l)
ToFormName.grdCol.TextMatrix(i, 8) = msgGrid.TextMatrix(j, 11)
ToFormName.grdCol.TextMatrix(i, 11) = msgGrid.TextMatrix(j, 26)
ToFormName.grdCol.TextMatrix(i, 32) = msgGrid.TextMatrix(j, 13)
ToFormName.grdCol.TextMatrix(i, 21) = msgGrid.TextMatrix(j, 29)
ToFormName.grdCol.TextMatrix(i, 33) = msgGrid.TextMatrix(j, 14)
ToFormName.grdCol.TextMatrix(i, 22) = msgGrid.TextMatrix(j, 30)
ToFormName.grdCol.TextMatrix(i, 23) = msgGrid.TextMatrix(j, 31)
ToFormName.grdCol.TextMatrix(i, 24) = msgGrid.TextMatrix(j, 32)
ToFormName.grdCol.TextMatrix(i, 25) = msgGrid.TextMatrix(j, 33)
ToFormName.grdCol.TextMatrix(i, 26) = msgGrid.TextMatrix(j, 34)
ToFormName.grdCol.TextMatrix(i, 27) = msgGrid.TextMatrix(j, 35)
ToFormName.grdCol.TextMatrix(i, 34) = msgGrid.TextMatrix(j, 15)
ToFormName.grdCol.TextMatrix(i, 35) = msgGrid.TextMatrix(j, 16)
ToFormName.grdCol.TextMatrix(i, 36) = msgGrid.TextMatrix(j, 17)
ToFormName.grdCol.TextMatrix(i, 37) = msgGrid.TextMatrix(j, 18)
ToFormName.grdCol.TextMatrix(i, 38) = msgGrid.TextMatrix(j, 19)
ToFormName.grdCol.TextMatrix(i, 39) = msgGrid.TextMatrix(j, 20)
ToFormName.grdCol.TextMatrix(i, 40) = msgGrid.TextMatrix(j, 23)
ToFormName.grdCol.TextMatrix(i, 41) = msgGrid.TextMatrix(j, n)
Else
ToFormName.grdCol.TextMatrix(k, 1) = msgGrid.TextMatrix(j, 24)
ToFormName.grdCol.TextMatrix(k, 28) = msgGrid.TextMatrix(j, 9)
ToFormName.grdCol.TextMatrix(k, 2) = msgGrid.TextMatrix(j, 22)
ToFormName.grdCol.TextMatrix(k, 29) = msgGrid.TextMatrix(j, 0)
ToFormName.grdCol.TextMatrix(k, 3) = msgGrid.TextMatrix(j, 28)
ToFormName.grdCol.TextMatrix(k, 30) = msgGrid.TextMatrix(j, 27)
ToFormName.grdCol.TextMatrix(k, 4) = msgGrid.TextMatrix(j, 25)
ToFormName.grdCol.TextMatrix(k, 31) = msgGrid.TextMatrix(j, 10)
ToFormName.grdCol.TextMatrix(k, 5) = msgGrid.TextMatrix(j, n)
ToFormName.grdCol.TextMatrix(k, 6) = msgGrid.TextMatrix(j, 12)
ToFormName.grdCol.TextMatrix(k, 14) = msgGrid.TextMatrix(j, l)
ToFormName.grdCol.TextMatrix(k, 8) = msgGrid.TextMatrix(j, 11)
ToFormName.grdCol.TextMatrix(k, 11) = msgGrid.TextMatrix(j, 26)
ToFormName.grdCol.TextMatrix(k, 32) = msgGrid.TextMatrix(j, 13)
ToFormName.grdCol.TextMatrix(k, 21) = msgGrid.TextMatrix(j, 29)
ToFormName.grdCol.TextMatrix(k, 33) = msgGrid.TextMatrix(j, 14)
ToFormName.grdCol.TextMatrix(k, 22) = msgGrid.TextMatrix(j, 30)
ToFormName.grdCol.TextMatrix(k, 23) = msgGrid.TextMatrix(j, 31)
ToFormName.grdCol.TextMatrix(k, 24) = msgGrid.TextMatrix(j, 32)
ToFormName.grdCol.TextMatrix(k, 25) = msgGrid.TextMatrix(j, 33)
ToFormName.grdCol.TextMatrix(k, 26) = msgGrid.TextMatrix(j, 34)
ToFormName.grdCol.TextMatrix(k, 27) = msgGrid.TextMatrix(j, 35)
ToFormName.grdCol.TextMatrix(k, 34) = msgGrid.TextMatrix(j, 15)
ToFormName.grdCol.TextMatrix(k, 35) = msgGrid.TextMatrix(j, 16)
ToFormName.grdCol.TextMatrix(k, 36) = msgGrid.TextMatrix(j, 17)
ToFormName.grdCol.TextMatrix(k, 37) = msgGrid.TextMatrix(j, 18)
ToFormName.grdCol.TextMatrix(k, 38) = msgGrid.TextMatrix(j, 19)
ToFormName.grdCol.TextMatrix(k, 39) = msgGrid.TextMatrix(j, 20)
ToFormName.grdCol.TextMatrix(k, 40) = msgGrid.TextMatrix(j, 23)
End If
blnColse = IIf(Trim(msgGrid.TextMatrix(j, m)) = "√", True, False)
slh = "Update PurchaseOrderDetail Set blnIsClose =" & blnColse & " Where lngPurchaseOrderDetailID=" & getnumber(j, 0) & ""
gclsBase.ExecSQL slh
End If
j = j + 1
Wend
j = 1
Do While j < ToFormName.grdCol.Rows '=0为未覆盖标志
ToFormName.CalcAmount j
j = j + 1
Loop
Me.MousePointer = vbDefault
If kkk = 1 Then
Unload Me
End If
'Exit Sub
'Err:
' ShowMsg Me.hWnd, "在向其它窗口传递数据时失败！ ", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "提示信息"
End Sub
'关联
'重定窗体中各控件的位置、大小
Private Sub Form_Resize()
End Sub
Private Sub RedrawForm()
End Sub
'Flexgrid显示栏目设置
Private Sub setColumn()
End Sub
Private Sub Form_Load()
' Set mclsGrid = New Grid
' Set mclsGrid.Grid = msgGrid
' Set bsdate = New Base
' mblnFormNoRezise = False
' mclsGrid.ColOfs = intfixl
' Cmdall(0).Picture = Utility.GetFormResPicture(1001, 0)
' Cmdall(1).Picture = Utility.GetFormResPicture(1002, 0)
' Cmdall(4).Picture = Utility.GetFormResPicture(1010, 0)
ToFormName.MousePointer = vbDefault
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set mclsGrid = Nothing
Set ToFormName = Nothing
' Utility.RemoveFormResPicture 1001
' Utility.RemoveFormResPicture 1002
' Utility.RemoveFormResPicture 1010
End Sub
'从Flexgrid中取出数字值
Private Function getnumber(getx As Integer, gety As Integer) As Double
If (Len(msgGrid.TextMatrix(getx, gety)) = 0 Or IsNull(msgGrid.TextMatrix(getx, gety))) Then
getnumber = 0
Else
getnumber = CDbl(msgGrid.TextMatrix(getx, gety))
End If
End Function
'本函数用于做结算与非结算处理
Private Sub msgGrid_Click()
End Sub
Private Sub msgGrid_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
With msgGrid
If .MouseCol = 1 Or msgGrid.TextMatrix(0, .MouseCol) = "关闭" Then
.MousePointer = vbCustom
Else
.MousePointer = vbDefault
End If
End With
End Sub
'右键菜单
Private Sub msgGrid_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
End Sub
Public Sub GivemeParameter(ToForm As Object, Optional dwID As Long = 0, Optional bzID As Long = 0, Optional ywID As Long = 0)
Set ToFormName = ToForm
ToFormName.MousePointer = vbHourglass
DetailID = ToFormName.getID
CustomerID = C2Lng(ToFormName.lblHead(0).Tag)
CurrencyID = ToFormName.GetFID(7)
blnIsPurchase = IIf(C2Lng(ToFormName.lblHead(2).Tag) = 4, True, False) '判断窗体单据是否为受托入库单据
If CustomerID < 1 Then
ToFormName.MousePointer = vbDefault
ShowMsg ToFormName.hwnd, "请先输入单位！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "选择订单"
Exit Sub
End If
If CurrencyID < 1 Then
ToFormName.MousePointer = vbDefault
ShowMsg ToFormName.hwnd, "请先输入币种！", MB_SYSTEMMODAL + MB_ICONEXCLAMATION, "选择订单"
Exit Sub
End If
Set mclsGrid = New Grid
Set mclsGrid.Grid = msgGrid
mclsGrid.ColOfs = intfixl
GetList
BalenceAll
ToFormName.MousePointer = vbDefault
Cmdall_Click (0)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -