📄 balance.bas
字号:
'连接所选取写对方Grid字段的表
strFrom = " FROM ((((((((((((((Item INNER JOIN (ItemActivity INNER JOIN ItemActivityDetail ON " _
& " ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) ON Item.lngItemID = ItemActivityDetail.lngItemID) " _
& " LEFT JOIN Custom0 ON Item.lngCustomID0 = Custom0.lngCustomID) LEFT JOIN Custom1 ON Item.lngCustomID1 = Custom1.lngCustomID) " _
& " LEFT JOIN Custom3 ON Item.lngCustomID3 = Custom3.lngCustomID) LEFT JOIN Custom4 ON Item.lngCustomID4 = Custom4.lngCustomID) " _
& " LEFT JOIN Custom5 ON Item.lngCustomID5 = Custom5.lngCustomID) LEFT JOIN Position ON Item.lngPositionID = Position.lngPositionID) " _
& " LEFT JOIN Tax ON ItemActivityDetail.lngTaxID = Tax.lngTaxID) LEFT JOIN JOb ON ItemActivityDetail.lngJobID = JOb.lngJobID) " _
& " LEFT JOIN ItemUnit ON ItemActivityDetail.lngUnitID = ItemUnit.lngUnitID) LEFT JOIN PurchaseOrderDetail " _
& " ON ItemActivityDetail.lngOrderDetailID = PurchaseOrderDetail.lngPurchaseOrderDetailID) LEFT JOIN PurchaseOrder " _
& " ON PurchaseOrderDetail.lngPurchaseOrderID = PurchaseOrder.lngPurchaseOrderID) LEFT JOIN Currencys " _
& " ON ItemActivity.lngCurrencyID = Currencys.lngCurrencyID) LEFT JOIN Rate ON Currencys.lngCurrencyID = Rate.lngCurrencyID) " _
& " LEFT JOIN Custom2 ON Item.lngCustomID2 = Custom2.lngCustomID"
'备份 strFrom = " FROM ((((((((((((((Item INNER JOIN (ItemActivity INNER JOIN ItemActivityDetail" _
& " ON ItemActivity.lngActivityID = ItemActivityDetail.lngActivityID) ON Item.lngItemID" _
& "= ItemActivityDetail.lngItemID) LEFT JOIN Custom0 ON Item.lngCustomID0 = " _
& "Custom0.lngCustomID) LEFT JOIN Custom1 ON Item.lngCustomID1 = Custom1.lngCustomID) " _
& "LEFT JOIN Custom3 ON Item.lngCustomID3 = Custom3.lngCustomID) LEFT JOIN Custom4 ON " _
& "Item.lngCustomID4 = Custom4.lngCustomID) LEFT JOIN Custom5 ON Item.lngCustomID5 = " _
& "Custom5.lngCustomID) LEFT JOIN Position ON Item.lngPositionID = Position.lngPositionID) " _
& "INNER JOIN Tax ON ItemActivityDetail.lngTaxID = Tax.lngTaxID) LEFT JOIN JOb ON " _
& "ItemActivityDetail.lngJobID = JOb.lngJobID) INNER JOIN ItemUnit ON (" _
& "ItemActivityDetail.lngUnitID = ItemUnit.lngUnitID) AND (Item.lngItemID = ItemUnit.lngItemID" _
& ")) LEFT JOIN PurchaseOrderDetail ON ItemActivityDetail.lngOrderDetailID = " _
& "PurchaseOrderDetail.lngPurchaseOrderDetailID) LEFT JOIN PurchaseOrder ON " _
& "PurchaseOrderDetail.lngPurchaseOrderID = PurchaseOrder.lngPurchaseOrderID) INNER JOIN " _
& "Currencys ON ItemActivity.lngCurrencyID = Currencys.lngCurrencyID) LEFT JOIN Rate ON " _
& "Currencys.lngCurrencyID = Rate.lngCurrencyID) LEFT JOIN Custom2 ON Item.lngCustomID2 = " _
& "Custom2.lngCustomID"
'开始写Grid
j = 1
With ToGrid
Do While j < .Rows
.TextMatrix(j, 41) = "0" '将写标志位置0
j = j + 1
Loop
End With
With FromGrid
i = 1
lngItemID = 999999999
intRow2 = 0
dblNumber = 0
Do While i < .Rows
'对本次金额不等于0或做了选择标志的列进行处理
If Val(.TextMatrix(i, intCurrAmountCol)) <> 0 Or .TextMatrix(i, 6) <> "" Then
lngActivityDetailID = .TextMatrix(i, 0)
' If .TextMatrix(i, 6) = "" Then
dblCurrAmount = C2Dbl(.TextMatrix(i, intCurrAmountCol))
' Else
' dblCurrAmount = .TextMatrix(i, 2)
' End If
' dblCurrAmount = dblCurrAmount * (100 + dblAdd) / 100 '取金额
' If intNumberCol > 0 Then
' dblNumber = C2Dbl(.TextMatrix(i, intNumberCol)) '取数量
' End If
' dblCurrPrice = C2Dbl(.TextMatrix(i, 1)) '取单价
strSql = strSelect
' strSql = strSql & "," & dblCurrAmount & " AS G8," & dblNumber & " AS G5," _
& dblCurrPrice & " AS G7 "
strSql = strSql & strFrom & " WHERE ItemActivityDetail.lngActivityDetailID=" & lngActivityDetailID
Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If Not recRecordset.EOF Then
With ToGrid
' If lngItemID <> recRecordset!G28 Then
' lngItemID = recRecordset!G28
j = 1
'查找单据行
Do While j < .Rows
If Val(.TextMatrix(j, 28)) = lngItemID Then
Exit Do
End If
j = j + 1
Loop
'若没找到则增加一行
lngItemID = 0
If j = .Rows Then
lngItemID = 1
If j > 1 Then
If C2lng(.TextMatrix(.Rows - 1, 28)) <> 0 Then '判断最后一行是否为空行
ToFormName.InsertARow
Else
j = j - 1
End If
Else
ToFormName.InsertARow
'.AddItem ("")
End If
End If
If lngItemID = 1 Then '判断要写入的商品在单据GRID中是否已经存在
.TextMatrix(j, 1) = recRecordset!G1 '商品名称
If recRecordset!G30 > 0 Then
.TextMatrix(j, 2) = recRecordset!G2 & " " & recRecordset!G82 '订单号
End If
.TextMatrix(j, 3) = IIf(IsNull(recRecordset!G3), "", recRecordset!G3) '货位
.TextMatrix(j, 4) = recRecordset!G4 '计量单位
.TextMatrix(j, 6) = recRecordset!G6 '单价
' .TextMatrix(j, 7) = recRecordset!G7
.TextMatrix(j, 8) = "100.00" '扣率
If blnSale Then
If IsNull(recRecordset!G112) = False Then
.TextMatrix(j, 11) = recRecordset!G112 '取销项税
End If
Else
If IsNull(recRecordset!G111) = False Then
.TextMatrix(j, 11) = recRecordset!G111 '取进项税
End If
End If
' .TextMatrix(j, 14) = dblCurrAmount
Call ToFormName.WriteGrd(dblCurrAmount, j, 14) '原币含税金额
'recRecordset!G14
' .TextMatrix(j, 15) = recRecordset!G15
.TextMatrix(j, 16) = recRecordset!G16 '分摊费用
.TextMatrix(j, 17) = IIf(IsNull(recRecordset!G17), "", recRecordset!G17)
.TextMatrix(j, 18) = recRecordset!G18 '生产日期
.TextMatrix(j, 19) = IIf(IsNull(recRecordset!G19), "", recRecordset!G19) '到期日期
.TextMatrix(j, 20) = IIf(IsNull(recRecordset!G20), "", recRecordset!G20) '保质期
.TextMatrix(j, 21) = IIf(IsNull(recRecordset!G21), "", recRecordset!G21) '工程
.TextMatrix(j, 22) = IIf(IsNull(recRecordset!G22), "", recRecordset!G22) '自定义项目1
.TextMatrix(j, 23) = IIf(IsNull(recRecordset!G23), "", recRecordset!G23) '自定义项目2
.TextMatrix(j, 24) = IIf(IsNull(recRecordset!G24), "", recRecordset!G24) '自定义项目3
.TextMatrix(j, 25) = IIf(IsNull(recRecordset!G25), "", recRecordset!G25) '自定义项目4
.TextMatrix(j, 26) = IIf(IsNull(recRecordset!G26), "", recRecordset!G26) '自定义项目5
.TextMatrix(j, 27) = IIf(IsNull(recRecordset!G27), "", recRecordset!G27) '自定义项目6
.TextMatrix(j, 28) = recRecordset!G28 '商品ID
.TextMatrix(j, 29) = IIf(IsNull(recRecordset!G29), "", recRecordset!G29) '订单号ID
If recRecordset!G30 > 0 Then
.TextMatrix(j, 30) = recRecordset!G30 '货位ID
End If
.TextMatrix(j, 31) = recRecordset!G31 '计量单位ID
.TextMatrix(j, 32) = recRecordset!G32 '税率ID
.TextMatrix(j, 33) = recRecordset!G33 '工程ID
.TextMatrix(j, 34) = recRecordset!G34 '自定义项目1ID
.TextMatrix(j, 35) = recRecordset!G35 '自定义项目2ID
.TextMatrix(j, 36) = recRecordset!G36 '自定义项目3ID
.TextMatrix(j, 37) = recRecordset!G37 '自定义项目4ID
.TextMatrix(j, 38) = recRecordset!G38 '自定义项目5ID '自定义项目6ID
.TextMatrix(j, 39) = recRecordset!G39 '自定义项目6ID
.TextMatrix(j, 40) = recRecordset!G40 '计量单位换算因子
.TextMatrix(j, 41) = "1" '置覆盖标志
.TextMatrix(j, 5) = FromGrid.TextMatrix(i, intNumberCol) '写数量
'recRecordset!G5
' .TextMatrix(j, 8) = recRecordset!G8
Else
If Trim(.TextMatrix(j, 41)) = "0" Then '判断是否有覆盖标志
.TextMatrix(j, 5) = FromGrid.TextMatrix(i, intNumberCol) '写数量
'recRecordset!G5
' .TextMatrix(j, 8) = recRecordset!G8
' .TextMatrix(j, 14) = dblCurrAmount
Call ToFormName.WriteGrd(dblCurrAmount, j, 14) '原币含税金额
'recRecordset!G14
.TextMatrix(j, 41) = "1"
Else
dblhl = Val(translate_minsl(ToGrid.TextMatrix(j, 5), recRecordset!G40)) + Val(translate_minsl(FromGrid.TextMatrix(i, intNumberCol), recRecordset!G40))
.TextMatrix(j, 5) = Balance.intTodec(dblhl, recRecordset!G40, True) '写数量
'recRecordset!G5
' .TextMatrix(j, 14) = C2Dbl(.TextMatrix(j, 14)) + dblCurrAmount
Call ToFormName.WriteGrd((C2Dbl(.TextMatrix(j, 14)) + dblCurrAmount), j, 14) '原币含税金额
'recRecordset!G8
End If
End If
End With
End If
End If
i = i + 1
Loop
End With
With ToGrid
j = 1
Do While j < .Rows
ToFormName.CalcAmount j
If C2Dbl(.TextMatrix(j, 14)) = 0 Then '原币含税金额等于零则删除
ToFormName.blnDeleteARow j
End If
j = j + 1
Loop
End With
End Sub
'取得商品ID
Public Function GetSalePurchaseItemID(ByRef objGrid As Object, ByVal lngID As Long) As Long
Dim i As Integer
Dim strSql As String
Dim recRecordset As rdoResultset
Dim lngItemID As Long
strSql = "SELECT ItemActivityDetail.lngItemID FROM ItemActivityDetail WHERE " _
& "ItemActivityDetail.lngActivityDetailID=" & lngID
Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If Not recRecordset.EOF() Then
lngItemID = recRecordset!lngItemID
End If
i = 1
' lngID
With objGrid
Do While i < .Rows
If lngItemID = C2lng(.TextMatrix(i, 28)) Then
GetSalePurchaseItemID = C2lng(.TextMatrix(i, 0))
Exit Function
End If
i = i + 1
Loop
End With
End Function
'存对话框
'根据商品业务明细ID得到商品业务ID
Public Function Get_MyItemActivityID(ByVal lngID As Long) As Long
Dim strSql As String
Dim recRecordset As rdoResultset
strSql = "SELECT ItemActivity.lngActivityID FROM ItemActivity INNER JOIN " _
& "ItemActivityDetail ON ItemActivity.lngActivityID = " _
& "ItemActivityDetail.lngActivityID WHERE ItemActivityDetail.lngActivityDetailID" _
& "=" & lngID
Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recRecordset.EOF() Then
Get_MyItemActivityID = 0
Else
Get_MyItemActivityID = recRecordset!lngActivityID
End If
End Function
Public Function RightData(strSource As String, dblData As Double) As String
'strSource：参照数量串
'dblInvoice：需要校正、转换的数量
'参照原数量串中的小数点位数，将当前DOUBLE型数量转换为对应小数点位数的显示数量字符串。
Dim str As String, p As Integer, l As Integer
str = Trim(strSource)
If Len(str) > 0 Then
l = InStr(1, str, ".")
If l > 0 Then
p = Len(Right(str, Len(str) - l))
End If
RightData = Format(dblData, FormatString(p))
Else
RightData = ""
End If
End Function
Public Function IsChange(ByRef FromGrid As Object, ByVal intSelect As Integer) As Boolean
'FromGrid ：需检测的GRID
'intSelect ：‘√’所在的列
'参照原数量串中的小数点位数，将当前DOUBLE型数量转换为对应小数点位数的显示数量字符串。
Dim p As Integer
IsChange = False
With FromGrid
p = 1
Do While p < .Rows And IsChange = False
If Trim(.TextMatrix(p, intSelect)) = "√" Then
IsChange = True
Else
p = p + 1
End If
Loop
End With
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -