Проценты - Несколько полезных функций
Public Function esProcentPlusMinus(curSum As Currency, intProcent As Integer, _
Optional btFixDig As Byte = 2) As Currency
On Error GoTo ProcentMinusErr
esProcentPlusMinus = CCur(Round(curSum * (intProcent / 100 + 1), btFixDig))
Exit Function
ProcentMinusErr:
esProcentPlusMinus = 0: Err.Clear
End Function
Public Function esProcentOut(curSum As Currency, intProcent As Integer, Optional bFixDig As Byte = 2) As Currency
Dim c As Integer
On Error GoTo ProcentOutErr
c = 100 + intProcent
esProcentOut = CCur(Round(curSum * 100 / c, bFixDig))
Exit Function
ProcentOutErr:
esProcentOut = 0: Err.Clear
End Function
Public Function esPaidPRC(curSum As Currency, curPaid As Currency, Optional bFixDig As Byte = 2) As Currency
On Error GoTo PaidPRCErr
esPaidPRC = CCur(Round((curPaid / curSum * 100), bFixDig))
Exit Function
PaidPRCErr:
esPaidPRC = 0: Err.Clear
End Function
Public Function esProcentBT(SumStart As Currency, SumEnd As Currency, Optional frp As Byte = 2) As Currency
On Error GoTo ProcentBTErr
esProcentBT = CCur(Round((SumEnd / SumStart * 100) - 100, frp))
Exit Function
ProcentBTErr:
esProcentBT = 0
End Function
Public Function ProcentMinus(curSum As Currency, intProcent As Integer, Optional btFixDig As Byte = 2) As Currency
On Error GoTo ProcentMinusErr
ProcentMinus = CCur(Round(curSum * (1 - intProcent / 100), btFixDig))
Exit Function
ProcentMinusErr:
ProcentMinus = 0: Err.Clear
End Function
Public Function esDiscountBySum(cSumStart As Currency, cSumDiscount As Currency, Optional frp As Byte = 2) As Currency
On Error GoTo DiscountBySum_Err
esDiscountBySum = CCur(Round(100 - (cSumDiscount / cSumStart * 100), frp))
Exit Function
DiscountBySum_Err:
esDiscountBySum = 0
End Function
|