📄 frmcalcdiscdetail.frm
字号:
Else
If Not blnSelect Then
GrdCol.TextMatrix(lngRow, 1) = ""
End If
End If
reCalculate
End Sub
Private Sub reCalculate()
Dim i As Integer
Dim j As Long
Dim dblTmp1 As Double
Dim dblTmp2 As Double
Dim dblPayedAmount As Double
Dim dblDiscItem As Double
Dim dblDiscSale As Double
Dim dblDiscQuantity As Double
Dim dblDiscCustomer As Double
Dim dblNoDiscAmount As Double
Dim blnDisced As Boolean
Dim blnFirstDisc As Boolean
Dim dblAmountForNoDisc As Double
Dim intIns As Integer
If dblQuantity <= 0 Then Exit Sub
dblCurrAmount = dblPriceTax * dblQuantity
GetLngColNO
intIns = Int((txtResult.width - 24 * Screen.TwipsPerPixelX) / (11 * txtResult.FontSize))
blnFirstDisc = True
dblNoDiscAmount = dblPriceNoDisc * dblQuantity
dblDiscAmount = 0
txtResult.Text = ""
txtResult.Text = txtResult.Text & "折扣前金额：" & Format(dblCurrAmount, strCurrDec) & Chr(13) & Chr(10)
txtResult.Text = txtResult.Text & "不折扣金额：" & Format(dblNoDiscAmount, strCurrDec) & Chr(13) & Chr(10)
txtResult.Text = txtResult.Text & String(intIns, "*") & Chr(13) & Chr(10)
For i = 0 To 4
Select Case bytOrder(i)
Case 1 '商品折扣
If blnDisced Then
txtResult.Text = txtResult.Text & String((Int(intIns / 2)), "-") & Chr(13) & Chr(10)
End If
DiscountItem lngItemID, dblCurrAmount - dblNoDiscAmount - dblDiscAmount, dblTmp1, dblDiscItem
txtResult.Text = txtResult.Text & "商品折扣金额：" & Format(dblDiscItem, strCurrDec) & Chr(13) & Chr(10)
dblDiscAmount = dblDiscAmount + dblDiscItem
blnDisced = True
Case 2 '贴息折扣
dblPayedAmount = dblDiscAmount
For j = 1 To GrdCol.Rows - 1
If GrdCol.TextMatrix(j, 1) <> "" Then
dblTmp1 = dblCurrAmount - dblNoDiscAmount - dblPayedAmount '- dblDiscAmount
If dblCurrAmount <= dblPayedAmount Then
Exit For
End If
If blnFirstDisc = False Then
txtResult.Text = txtResult.Text & String(Int(intIns / 4), "-") & Chr(13) & Chr(10)
Else
If blnDisced Then
txtResult.Text = txtResult.Text & String(Int(intIns / 2), "-") & Chr(13) & Chr(10)
End If
txtResult.Text = txtResult.Text & "贴息折扣计算：" & Chr(13) & Chr(10)
End If
blnFirstDisc = False
blnDisced = True
txtResult.Text = txtResult.Text & " " & GrdCol.TextMatrix(j, xlngColNo(4)) & "日" & vbTab & GrdCol.TextMatrix(j, xlngColNo(2)) & vbTab & "贴息计算：" & Chr(13) & Chr(10)
If dblTmp1 < 0 Then
dblTmp1 = dblNoDiscAmount - dblAmountForNoDisc
If dblTmp1 < C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5))) Then
Else
dblTmp1 = C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5)))
End If
txtResult.Text = txtResult.Text & vbTab & "付不折扣金额： " & Format(dblTmp1, strCurrDec) & Chr(13) & Chr(10)
dblRowData(j, 2) = dblTmp1
dblPayedAmount = dblPayedAmount + dblTmp1
dblAmountForNoDisc = dblAmountForNoDisc + dblTmp1
'
' If dblCurrAmount <= dblPayedAmount Then
' If OptReturn(1).Value = True Then
'ByPrice:
' dblTmp1 = Format((dblCurrAmount - dblDiscAmount) * dblFactor / dblQuantity, strPriceDec)
' dblTmp1 = dblTmp1 * dblQuantity / dblFactor
' If dblTmp1 > dblCurrAmount Then
' If dblRowData(j, 2) + dblTmp1 - dblCurrAmount <= C2Dbl(GrdCol.TextMatrix(j, xlngcolno(5))) Then
' dblRowData(j, 2) = dblRowData(j, 2) + dblTmp1 - dblCurrAmount
' Else
' dblRowData(j, 2) = C2Dbl(GrdCol.TextMatrix(j, xlngcolno(5)))
' End If
' Else
' Dim k As Long
' dblTmp2 = 0
'
' For k = j To 1 Step -1
' If dblCurrAmount - dblTmp1 > dblTmp2 Then
' If dblRowData(k, 2) >= dblCurrAmount - dblTmp1 - dblTmp2 Then
' dblRowData(k, 2) = dblRowData(j, 2) + dblCurrAmount - dblTmp1 - dblTmp2
' Exit For
' Else
' dblTmp2 = dblTmp2 + dblRowData(k, 2)
' dblRowData(k, 2) = 0
' End If
' End If
' Next
' End If
' End If
' End If
' txtResult.Text = txtResult.Text & vbTab & "付款金额： " & Format(dblRowData(j, 2), strCurrDec) & Chr(13) & Chr(10)
Else
' dblAmountForNoDisc = 0
If blnDiscMethod Then
If OptReturn(1).Value = True Then
If C2Dbl(Format(dblTmp1 * (C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100) * dblFactor / dblQuantity, strPriceDec)) * dblQuantity / dblFactor > C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5))) Then
dblTmp2 = C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5)))
txtResult.Text = txtResult.Text & vbTab & "折扣金额： "
dblTmp1 = dblTmp2 * 100 / C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) - dblTmp2
If C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) <> 100 Then
dblRowData(j, 2) = dblTmp1 / (1 - (C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100)) - dblTmp1
Else
dblRowData(j, 2) = dblTmp2
End If
dblPayedAmount = dblPayedAmount + dblTmp1 + dblTmp2
txtResult.Text = txtResult.Text & Format(dblTmp2, strCurrDec) & "÷" & GrdCol.TextMatrix(j, xlngColNo(6)) & "%-" & Format(dblTmp2, strCurrDec) & "=" & Format(dblTmp1, strCurrDec) & Chr(13) & Chr(10)
Else
' dblCurrAmount = dblCurrAmount - dblTmp1 + C2Dbl(Format(dblTmp1 * (C2Dbl(GrdCol.TextMatrix(j, xlngcolno(6))) / 100) * dblFactor / dblQuantity, strPriceDec)) * dblQuantity / dblFactor
txtResult.Text = txtResult.Text & vbTab & "折扣金额： " & Format(dblTmp1, strCurrDec) & "-" & Format(dblTmp1, strCurrDec)
dblTmp2 = C2Dbl(Format(dblTmp1 * (C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100) * dblFactor / dblQuantity, strPriceDec)) * dblQuantity / dblFactor
dblPayedAmount = dblPayedAmount + dblTmp1
' txtResult.Text = txtResult.Text & vbTab & "折扣金额： " & Format(dblTmp1, strCurrDec) & "-" & Format(dblTmp1, strCurrDec)
dblRowData(j, 2) = dblTmp2
If C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) <> 100 Then
dblTmp1 = dblTmp1 - dblTmp2
' dblRowData(j, 2) = dblTmp1 / (1 - (C2Dbl(GrdCol.TextMatrix(j, xlngcolno(6))) / 100)) - dblTmp1
Else
dblTmp1 = 0
End If
' dblPayedAmount = dblPayedAmount + dblRowData(j, 2)
txtResult.Text = txtResult.Text & "×" & GrdCol.TextMatrix(j, xlngColNo(6)) & "%=" & Format(dblTmp1, strCurrDec) & Chr(13) & Chr(10)
End If
Else
If dblTmp1 * (C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100) > C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5))) Then
dblTmp2 = C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5)))
txtResult.Text = txtResult.Text & vbTab & "折扣金额： "
dblTmp1 = dblTmp2 * 100 / C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) - dblTmp2
If C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) <> 100 Then
dblRowData(j, 2) = dblTmp1 / (1 - (C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100)) - dblTmp1
Else
dblRowData(j, 2) = dblTmp2
End If
dblPayedAmount = dblPayedAmount + dblTmp1 + dblTmp2
txtResult.Text = txtResult.Text & Format(dblTmp2, strCurrDec) & "÷" & GrdCol.TextMatrix(j, xlngColNo(6)) & "%-" & Format(dblTmp2, strCurrDec) & "=" & Format(dblTmp1, strCurrDec) & Chr(13) & Chr(10)
Else
dblPayedAmount = dblPayedAmount + dblTmp1
txtResult.Text = txtResult.Text & vbTab & "折扣金额： " & Format(dblTmp1, strCurrDec) & "-" & Format(dblTmp1, strCurrDec)
If C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) <> 100 Then
dblTmp1 = dblTmp1 - dblTmp1 * C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100
dblRowData(j, 2) = dblTmp1 / (1 - (C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100)) - dblTmp1
Else
dblRowData(j, 2) = dblTmp1
dblTmp1 = 0
End If
' dblPayedAmount = dblPayedAmount + dblRowData(j, 2)
txtResult.Text = txtResult.Text & "×" & GrdCol.TextMatrix(j, xlngColNo(6)) & "%=" & Format(dblTmp1, strCurrDec) & Chr(13) & Chr(10)
End If
End If
Else
If dblTmp1 / (2 - C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100) > C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5))) Then
dblTmp1 = C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5)))
txtResult.Text = txtResult.Text & vbTab & "折扣金额： " & Format(dblTmp1, strCurrDec) & "-" & Format(dblTmp1, strCurrDec)
dblTmp1 = dblTmp1 - dblTmp1 * C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100
txtResult.Text = txtResult.Text & "×(1-" & GrdCol.TextMatrix(j, xlngColNo(6)) & "%)=" & Format(dblTmp1, strCurrDec) & Chr(13) & Chr(10)
dblRowData(j, 2) = dblTmp1 * (1 + (C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100))
dblPayedAmount = dblPayedAmount + dblRowData(j, 2)
Else
txtResult.Text = txtResult.Text & vbTab & "折扣金额： " & Format(dblTmp1, strCurrDec) & "-" & Format(dblTmp1, strCurrDec)
dblTmp1 = dblTmp1 - dblTmp1 / (1 + C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100)
txtResult.Text = txtResult.Text & "÷(1+" & GrdCol.TextMatrix(j, xlngColNo(6)) & "%)=" & Format(dblTmp1, strCurrDec) & Chr(13) & Chr(10)
dblRowData(j, 2) = dblTmp1 * (1 + (C2Dbl(GrdCol.TextMatrix(j, xlngColNo(6))) / 100))
dblPayedAmount = dblPayedAmount + dblRowData(j, 2)
End If
End If
dblDiscAmount = dblDiscAmount + dblTmp1
txtResult.Text = txtResult.Text & vbTab & "折扣后金额：" & Format(dblCurrAmount - dblDiscAmount, strCurrDec) & Chr(13) & Chr(10)
' dblRowData(j, 2) = dblCurrAmount - dblDiscAmount - dblNoDiscAmount
If dblRowData(j, 2) + dblNoDiscAmount > C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5))) Then
If dblRowData(j, 2) < C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5))) Then
dblAmountForNoDisc = C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5))) - dblRowData(j, 2)
Else
dblAmountForNoDisc = 0
End If
dblRowData(j, 2) = C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5)))
Else
dblAmountForNoDisc = dblNoDiscAmount
dblRowData(j, 2) = dblRowData(j, 2) + dblNoDiscAmount
End If
dblPayedAmount = dblPayedAmount + dblAmountForNoDisc
' If dblCurrAmount <= dblPayedAmount And OptReturn(1).Value = True Then
' If C2Dbl(GrdCol.TextMatrix(j, xlngcolno(5))) < dblRowData(j, 2) Then
' dblRowData(j, 2) = C2Dbl(GrdCol.TextMatrix(j, xlngcolno(5)))
' End If
' GoTo ByPrice
' Else
txtResult.Text = txtResult.Text & vbTab & "付款金额： " & Format(dblRowData(j, 2), strCurrDec) & Chr(13) & Chr(10)
If C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5))) < dblRowData(j, 2) Then
dblRowData(j, 2) = C2Dbl(GrdCol.TextMatrix(j, xlngColNo(5)))
End If
' End If
End If
CalcNext:
End If
Next
If dblNowDiscRate <> 1 And dblCurrAmount > dblPayedAmount Then
dblTmp1 = dblCurrAmount - dblNoDiscAmount - dblPayedAmount
If dblTmp1 > 0 Then
If blnFirstDisc = False Then
txtResult.Text = txtResult.Text & String(Int(intIns / 4), "-") & Chr(13) & Chr(10)
Else
If blnDisced Then
txtResult.Text = txtResult.Text & String(Int(intIns / 2), "-") & Chr(13) & Chr(10)
End If
txtResult.Text = txtResult.Text & "贴息折扣计算：" & Chr(13) & Chr(10)
End If
blnDisced = True
txtResult.Text = txtResult.Text & " 本期折扣：" & Chr(13) & Chr(10)
txtResult.Text = txtResult.Text & vbTab & "折扣金额： " & Format(dblTmp1, strCurrDec) & "-" & Format(dblTmp1, strCurrDec)
dblTmp1 = dblTmp1 - dblTmp1 * dblNowDiscRate
txtResult.Text = txtResult.Text & "×" & Format(dblNowDiscRate * 100, "0.00") & "%=" & Format(dblTmp1, strCurrDec) & Chr(13) & Chr(10)
dblDiscAmount = dblDiscAmount + dblTmp1
txtResult.Text = txtResult.Text & vbTab & "折扣后金额：" & Format(dblCurrAmount - dblDiscAmount, strCurrDec) & Chr(13) & Chr(10)
End If
End If
Case 3 '批量折扣
If blnDisced Then
txtResult.Text = txtResult.Text & String(Int(intIns / 2), "-") & Chr(13) & Chr(10)
End If
dblTmp1 = 0
DiscountBatch lngItemID, dblQuantity, (dblCurrAmount - dblNoDiscAmount - dblDiscAmount) * dblRate, dblTmp1, dblDiscQuantity
dblDiscQuantity = dblDiscQuantity / dblRate
txtResult.Text = txtResult.Text & "批量折扣金额：" & Format(dblDiscQuantity, strCurrDec) & Chr(13) & Chr(10)
dblDiscAmount = dblDiscAmount + dblDiscQuantity
blnDisced = True
Case 4 '促销折扣
If blnDisced Then
txtResult.Text = txtResult.Text & String(Int(intIns / 2), "-") & Chr(13) & Chr(10)
End If
DiscountSale lngItemID, strDate, dblCurrAmount - dblNoDiscAmount - dblDiscAmount, dblTmp1, dblDiscSale
txtResult.Text = txtResult.Text & "促销折扣金额：" & Format(dblDiscSale, strCurrDec) & Chr(13) & Chr(10)
dblDiscAmount = dblDiscAmount + dblDiscSale
blnDisced = True
Case 5 '客户折扣
If blnDisced Then
txtResult.Text = txtResult.Text & String(Int(intIns / 2), "-") & Chr(13) & Chr(10)
End If
DiscountCustomer lngCustomerID, dblCurrAmount - dblNoDiscAmount - dblDiscAmount, dblTmp1, dblDiscCustomer
txtResult.Text = txtResult.Text & "客户折扣金额：" & Format(dblDiscCustomer, strCurrDec) & Chr(13) & Chr(10)
dblDiscAmount = dblDiscAmount + dblDiscCustomer
blnDisced = True
End Select
Next
If blnDisced = True Then
txtResult.Text = txtResult.Text & String(intIns, "*") & Chr(13) & Chr(10)
End If
txtResult.Text = txtResult.Text & "折扣金额： " & Format(dblDiscAmount, strCurrDec) & Chr(13) & Chr(10)
txtResult.Text = txtResult.Text & "折扣后金额：" & Format(dblCurrAmount - dblDiscAmount, strCurrDec)
calPrice.Text = Format((dblCurrAmount - dblDiscAmount) * dblFactor / dblQuantity, strPriceDec)
End Sub
Private Sub calPrice_Validate(Cancel As Boolean)
Dim i As Long
If Abs(C2Dbl(calPrice.Text)) >= (10 ^ 12) Then
calPrice.Text = IIf(C2Dbl(calPrice.Text) > 0, "", "-") & "999999999999"
End If
' If C2Dbl(calPrice.Text) <> (dblCurrAmount - dblDiscAmount) * dblFactor / dblQuantity Then
If ChkAdjust.Value <> 0 Then
For i = 1 To GrdCol.Rows - 1
If GrdCol.TextMatrix(i, 1) <> "" Then
GrdCol.TextMatrix(i, 1) = ""
End If
Next
dblDiscAmount = 0
txtResult.Text = ""
txtResult.Text = "手工调价：" & Chr(13) & Chr(10)
txtResult.Text = txtResult.Text & " 单价：" & calPrice.Text & Chr(13) & Chr(10)
txtResult.Text = txtResult.Text & " 金额：" & Format(C2Dbl(calPrice.Text) * dblQuantity / dblFactor, strCurrDec) & Chr(13) & Chr(10)
OptReturn(1).Value = True
End If
calPrice.Text = Format(calPrice.Text, strPriceDec)
End Sub
Private Sub calPrice_KeyUp(ByVal KeyCode As Integer, ByVal Shift As Integer)
If KeyCode = 13 Then
calPrice_Validate False
If OptReturn(0).Enabled Then
OptReturn(0).SetFocus
End If
End If
End Sub
Private Function ColName(ByVal lngCol As Long) As String
Dim strTmp As String
strTmp = GrdCol.TextMatrix(0, lngCol)
If InStr(strTmp, "↑") <> 0 Or InStr(strTmp, "↓") <> 0 Then
strTmp = Left(strTmp, Len(strTmp) - 1)
End If
ColName = strTmp
End Function
Private Sub GetLngColNO()
Dim i As Integer
Dim j As Integer
For i = 2 To GrdCol.Cols - 1
For j = 2 To GrdCol.Cols - 1
If strColName(i) = ColName(j) Then
xlngColNo(i) = j
Exit For
End If
Next
Next
End Sub
Private Sub OptReturn_Click(Index As Integer)
If Index = 0 Then
reCalculate
Else
reCalculate
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -