Решение ситуации, когда товар имел цены в $, оплатили его в $, но за прошедшее время курс изменился, и в грн долг не закрывается (
viewtopic.php?f=1&t=2028).
Сначала создадим отдельную операцию, чтобы применять ее выборочно - только когда известно, что покупатель с нами или мы с поставщиком полностью рассчитались, а если долг не закрывается на какую-то сумму, то это из-за курсовой разницы.
Для расчетов с покупателями: открыть Документы/Касса/Приход, нажать вверху "Выбор операции", нажать "По образцу".
- 1.png (15.01 КБ) Просмотров: 4056
Задать название "Расплатился полностью" или "Полный расчет" и нажать "Программа".
- 2.png (18.24 КБ) Просмотров: 4056
Скопировать и вставить следующий текст:
Dim PokupID As Integer = Op.PersonID
If PokupID = 0 Then Exit Sub
Dim CaseInt As Integer, Trans As Predpr.TransRow, R As Predpr.TableSQL
Dim Str As String = "SELECT Sum(PriceReport*Quantity*[Sign]) AS [Sum] FROM Data_Persons "
Str = Str & "WHERE PersonID=" & PokupID & " AND DocDate<=" & Predpr.GlobalFunction.SQLdate(Op.DocDate) & " AND DocID<>" & Op.ID
R = Predpr.DataMain.DBmain.OpenRecordset(Str)
Dim OpSum As Decimal = Predpr.GlobalFunction.InTargetCurr(Predpr.DataMain.ReportCurrID, 1, Op.DocSum, Op.DocDate)
Dim Sum As Decimal = R("Sum") - OpSum
R.Close()
Select Case Sum
Case Is > 0.01
CaseInt = 1
Case Is < -0.01
CaseInt = 2
Case Else
Exit Sub
End Select
Dim TempID As Integer = Predpr.DataMain.Tmpl_RateMinus
Dim TemplKurs As Predpr.Templ = Predpr.DataMain.AppData.TemplsCollection.Item(TempID)
Dim TrTempl As Predpr.TemplRow = TemplKurs.TemplRowsCalc(1)
Dim AccKursID As Integer = TrTempl.TransRow.AccDbID
If Op.DocTransCalc.Count > 1 Then
Op.DocTransCalc.Remove(2)
End If
Trans = Op.DocTransCalc(1)
Dim TrNew As New Predpr.TransRow(Op, Op.OfficeID, PokupID)
Dim AbsSum As Decimal = System.Math.Abs(Sum)
TrNew.FlagDb = True
TrNew.FlagCr = True
Select Case CaseInt
Case 1
TrNew.AccDbID = AccKursID
TrNew.AccCrID = Trans.AccCrID
Microsoft.VisualBasic.MsgBox(AbsSum.ToString("0.00") & " долга списано на убытки", , "Курсовая разница")
Case 2
TrNew.AccCrID = AccKursID
TrNew.AccDbID = Trans.AccCrID
Microsoft.VisualBasic.MsgBox(AbsSum.ToString("0.00") & " долга зачислено в доход", , "Курсовая разница")
End Select
Dim SRow As New Predpr.SubRow(TrNew)
SRow.Qnt = 1
SRow.Price = AbsSum
SRow.CurrID = Predpr.DataMain.ReportCurrID
Op.DocTransCalc.Add(2, TrNew)Для расчетов с поставщиками, аналогично - Документы/Касса/Расход, создать операцию "Расплатились полностью", ввести следующий текст:
Dim PokupID As Integer = Op.PersonID
If PokupID = 0 Then Exit Sub
Dim CaseInt As Integer, Trans As Predpr.TransRow, R As Predpr.TableSQL
Dim Str As String = "SELECT Sum(PriceReport*Quantity*[Sign]) AS [Sum] FROM Data_Persons "
Str = Str & "WHERE PersonID=" & PokupID & " AND DocDate<=" & Predpr.GlobalFunction.SQLdate(Op.DocDate) & " AND DocID<>" & Op.ID
R = Predpr.DataMain.DBmain.OpenRecordset(Str)
Dim OpSum As Decimal = Predpr.GlobalFunction.InTargetCurr(Predpr.DataMain.ReportCurrID, 1, Op.DocSum, Op.DocDate)
Dim Sum As Decimal = R("Sum") + OpSum
R.Close()
Select Case Sum
Case Is > 0.01
CaseInt = 1
Case Is < -0.01
CaseInt = 2
Case Else
Exit Sub
End Select
Dim TempID As Integer = Predpr.DataMain.Tmpl_RateMinus
Dim TemplKurs As Predpr.Templ = Predpr.DataMain.AppData.TemplsCollection.Item(TempID)
Dim TrTempl As Predpr.TemplRow = TemplKurs.TemplRowsCalc(1)
Dim AccKursID As Integer = TrTempl.TransRow.AccDbID
If Op.DocTransCalc.Count > 1 Then
Op.DocTransCalc.Remove(2)
End If
Trans = Op.DocTransCalc(1)
Dim TrNew As New Predpr.TransRow(Op, Op.OfficeID, PokupID)
Dim AbsSum As Decimal = System.Math.Abs(Sum)
TrNew.FlagDb = True
TrNew.FlagCr = True
Select Case CaseInt
Case 1
TrNew.AccDbID = AccKursID
TrNew.AccCrID = Trans.AccDbID
Microsoft.VisualBasic.MsgBox(AbsSum.ToString("0.00") & " долга списано на убытки", , "Курсовая разница")
Case 2
TrNew.AccCrID = AccKursID
TrNew.AccDbID = Trans.AccDbID
Microsoft.VisualBasic.MsgBox(AbsSum.ToString("0.00") & " долга зачислено в доход", , "Курсовая разница")
End Select
Dim SRow As New Predpr.SubRow(TrNew)
SRow.Qnt = 1
SRow.Price = AbsSum
SRow.CurrID = Predpr.DataMain.ReportCurrID
Op.DocTransCalc.Add(2, TrNew)Как это будет действовать.
Если с учетом этой оплаты долг закрывается, проводки останутся без изменений:
- 4.png (8.55 КБ) Просмотров: 4056
Если образуется разница, она будет добавлена:
- 5.png (10.42 КБ) Просмотров: 4056
Кроме того появится сообщение об этих действиях:
- 6.png (3.56 КБ) Просмотров: 4056
или:
- 7.png (3.46 КБ) Просмотров: 4056
