Տպելու ձևանմուշների օգտագործողի կողմից նկարագրված պարամետրերի ենթածրագրեր

1. Կադրային փաստաթղթերի տպվող տեսքերում հնարավոր է տպել աշխատակցի տվյալ հավելման մաքուր գումարը, հաշվի առնելով նաև նրա սոցիալական վճար վճարելու հանգամանքը։

Function GrossSumToNetSum
  dim grossSum, netSum
  grossSum = Templateparam("1330")
  If grossSum <= 150000 and trim(templateparam("1186")) = "0" Then
    netSum = grossSum - grossSum * 0.23

  Elseif grossSum > 150000  and grossSum <= 2000000  and trim(templateparam("1186")) = "0" Then
    netSum =  grossSum- ((grossSum - 150000) * 0.28 + 34500)

  Elseif grossSum > 2000000 and trim(templateparam("1186")) = "0" Then
    netSum = grossSum - ((grossSum-2000000) * 0.36 + 552500)

  ElseIf grossSum <= 150000 and trim(templateparam("1186")) = "1" and grossSum*5/100 >= 25000 Then
    netSum = grossSum - grossSum * 0.23 - 25000

  Elseif grossSum > 150000  and grossSum <= 2000000  and trim(templateparam("1186")) = "1" and grossSum*5/100 >= 25000 Then
    netSum =  grossSum- ((grossSum - 150000) * 0.28 + 34500) - 25000

  Elseif grossSum > 2000000 and trim(templateparam("1186")) = "1" and  grossSum*5/100 >= 25000 Then
    netSum = grossSum - ((grossSum-2000000) * 0.36 + 552500) - 25000

  ElseIf grossSum <= 150000 and trim(templateparam("1186")) = "1" and grossSum*5/100 < 25000 Then
    netSum = grossSum - grossSum * 0.23 - grossSum*5/100

  Elseif grossSum > 150000  and grossSum <= 2000000  and trim(templateparam("1186")) = "1" and grossSum*5/100 < 25000 Then
    netSum =  grossSum- ((grossSum - 150000) * 0.28 + 34500) - grossSum*5/100

  Elseif grossSum > 2000000 and trim(templateparam("1186")) = "1" and  grossSum*5/100 < 25000 Then
    netSum = grossSum - ((grossSum-2000000) * 0.36 + 552500) - grossSum*5/100

  Else 
    NetSum = templateParam("1330")
  End if
  GrossSumToNetSum = netSum
End Function

Դիտելու ձևերի ենթածրագրեր

1. Որևէ մի փաստաթղթից դուրս գալ իր ենթափաստաթղթերի վրա և ֆիլտրելով այդ ենթափաստաթղթերի որոշակի դաշտի արժեքով ստանալ այդ ենթափաստաթղթերի գրիդերից որոշակի տվյալներ։

Օրինակ՝ Գործուղման վկայականների տողերի հիման վրա դուրս գալ իր Խմբային հիշարար օրդեր ենթափաստաթղթերի վրա։ Ֆիլտրել հիշարար օրդերները արժույթի կոդով և այդ ֆիլտրված հիշարար օրդերի գրիդի տողերի համար հաշվել արտարժութային գումարների հանրագումարը։

Function ChildrenSum
Dim childrens
Dim SumTotal
nCURS = 0

Set childrens = GetDocChildren(value("FISN"),"MemOrdGr")
If not childrens is nothing Then
 SumTotal = 0
 For i = 1 To childrens.Count
  If GetRekvValue(childrens(i),"CUR") = value("CURCODE") Then
   With  LoadDoc(childrens(i)).Grid("TRANS")
   For e = 0 To .RowCount - 1
    SumTotal = SumTotal + .value(e, "CURSUM")
   Next
   End With   
  Else
   With  LoadDoc(childrens(i)).Grid("TRANS")
   For e = 0 To .RowCount - 1
    nCURS = left(.value(e, "COURSE"),11)/right(.value(e, "COURSE"),5)
    If round(.value(e, "CURSUM")/nCURS,0) = round(Value("BSUM"),0) then
     SumTotal = SumTotal + .value(e, "CURSUM")
    End If
   Next
   End With
  End If
 ChildrenSum = SumTotal
 Next
End if
End function

Հարկային ծրագիր արտահանվող փաստաթղթի կարգավորումներ

1. ՎՀԱ-ի ՆԱ-ի անվանումը արտահանելիս հայերեն անվանմանը ավելացնում ենք ՆԱ-ի անգլերեն անվանումը, Մատակարարի լրացուցիչ տվյալներ(պայմաններ)-ը տեղափոխում ենք ընդհանուր լրացուցիչ տվյալներ(պայմաններ) դաշտի մեջ:

Option Explicit

Sub MakeChangesToTaxDoc
Dim i
Dim docMaterial
Dim felMaterial

    set docMaterial = nothing
    set felMaterial = nothing

    With Doc.Grid("Price")
        For i = 0 to .RowCount - 1
            Set felMaterial = FolderElProp("Material", .Value(i, "Code"))
            If not felMaterial is nothing then
                Set docMaterial = LoadDoc(felMaterial.ISN)
            End If
            If Not docMaterial is Nothing Then
                .Value(i, "PrName") = Trim(docMaterial("EName")) & " " & Trim(.Value(i, "PrName"))
            End If
        Next
    End With
    Doc.Rekv("SAdditional") = Doc.Rekv("Additional")
    Doc.Rekv("Additional") = ""
End Sub

2. Պահանջագիր ծախս փաստաթղթի մեջ բացակայում է մուտքի պահեստի դաշտը, սակայն առկա է ծախսային կենտրոնը: Ծախսային կենտրոն փաստաթուղթը կարելի է ընդլայնել ավելացնելով "Հասցե" դաշտը: Հարկային ծրագիր արտահանելիս մատակարարման հասցե դաշտում լրացվում է համապատասխան ծախսային կենտրոնում լրացված հասցեն։

Option Explicit

Sub MakeChangesToTaxDoc

    If ParentDoc.DocType = "Delivery" and trim(ParentDoc.Rekv("STORAGEIN")) = "" then
        Doc.Rekv("SConveyLoc") = FolderRekvValue("MTDepart",ParentDoc.Rekv("REQUESTER"),"UDRHASCE")
    End If
End Sub

Հաստատման սխեմաների ակտիվացման բանաձևերի և ենթածրագրերի օրինակներ

1. Պատվեր հայտ փաստաթղթի համար ակտիվացնում ենք հաստատման սխեման այն դեպքում, երբ նշված փաստաթղթի ստորաբաժանումը = "001" և պատվերի հանրագումարի համարժեքը դոլարով չի գերանզանցում 19000։

Ակտիվացման բանաձև՝

CheckDepartment and CheckSumLess

Ենթածրագիր՝

Function CheckDepartment
    CheckDepartment= Doc("DIVISION") = "001"
End Function

Function CheckSumLess
    if SumInDollar <= 19000 then
       CheckSumLess = True
    else
       CheckSumLess = False
    end if
End Function

Function SumInDollar
    if Doc("CUR") = "000" then
       tmpRate = CurRate("001",Doc("DATE"))
    elseif Doc("CUR") = "001" then
       tmpRate = 1
    else
       tmpRate=CurRate("001",Doc("DATE"))/CurRate(Doc("CUR"),Doc("DATE"))
    end if
    SumInDollar = Doc("SUMALL")/tmpRate
End Function

Փաստաթղթի փոփոխման էլ․փոստով ծանուցումների նկարագրությունների օրինակներ

1. ՊՄՕ փաստաթուղթը Պատվեր մատակարարին փաստաթղթի հիման վրա ստեղծելու կամ ջնջելու ժամանակ, Պատվեր մատակարարին ստեղծողին ուղարկվի էլեկտրոնային հաղորդագրություն։

Բեռնել փաստաթղթի փոփոխման էլ․փոստով ծանուցումների նկարագրությունը

2. Կադրեր ենթահամակարգից Կադրային թերթիկի (աշխատակցի) անձնական հաշիվները (գրիդ է) կամ օգտագործողի կոդը (սովորական դաշտ է)  խմբագրելուց ուղարկվի էլեկտրոնային հաղորդագրություն։ Ենթածրագրով համոզվում ենք, որ այդ երկու տվյալներից մեկնումեկը կամ երկուսն էլ փոփոխվել են։

Բեռնել փաստաթղթի փոփոխման էլ․փոստով ծանուցումների նկարագրությունը

1. Նշված տիրույթի համար merge արած բջջիջները  դարձնում է unmerge և արժեքը գրանցում է բոլոր unmerge բջջիջների համար:

Sub UnMerge_and_Fill_by_Value()
Dim sValue As String, sAddress As String
Dim rRange As Range, rCell As Range
Dim i As Integer
Application.ScreenUpdating = False
Set rRange = Intersect(Selection, Range(Cells(Selection.Row, Selection.Column), _
Cells(Cells.SpecialCells(xlLastCell).Row, _
Selection.Column + Selection.Columns.Count - 1)))
i = 0
For Each rCell In rRange
If rCell.MergeCells = True Then
   sValue = rCell.Value: sAddress = rCell.MergeArea.Address
   rCell.UnMerge: Range(sAddress).Value = rCell.Value
   i = i + 1
End If
Next
Application.ScreenUpdating = True
MsgBox "Ok. Processed " & i & " cells"
End Sub

2. Նշված տիրույթում բոլոր դատարկ արժեքների համար ավելացնում է մեկ դատարկ նիշ: Թիվ լինելու դեպքում նույնպես ավելացնում է ձախից մեկ դատարկ նիշ, որի շնորհիվ այն դառնում է տեքստային:

Sub Add_Space_For_Charaters()
Dim sValue As String
Dim rRange As Range, rCell As Range
Dim i As Integer
Dim j As Integer
Application.ScreenUpdating = False
Set rRange = Intersect(Selection, Range(Cells(Selection.Row, Selection.Column), _
Cells(Cells.SpecialCells(xlLastCell).Row, _
Selection.Column + Selection.Columns.Count - 1)))
i = 0
j = 0
For Each rCell In rRange
If rCell.Value = "" Then
   rCell.Value = " "
   i = i + 1
Else
   If IsNumeric(rCell.Value) Then
      rCell.Value = "'" & rCell.Value
      j = j + 1
   End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Ok. " & i & " Empty String; " & j & " Numeric To String"
End Sub

3. Նշված տիրույթում բոլոր դատարկ արժեքների համար լրացնում է 0:

Sub Add_Zero_For_Numerics()
Dim sValue As String, sAddress As String
Dim rRange As Range, rCell As Range
Dim i As Integer
Application.ScreenUpdating = False
Set rRange = Intersect(Selection, Range(Cells(Selection.Row, Selection.Column), _
Cells(Cells.SpecialCells(xlLastCell).Row, _
Selection.Column + Selection.Columns.Count - 1)))
i = 0
For Each rCell In rRange
If Trim(rCell.Value) = "" Then
   rCell.Value = 0
   i = i + 1
End If
Next
Application.ScreenUpdating = True
MsgBox "Ok. " & i & " empty strings changed to zero value"
End Sub

4. Նշված տիրույթում բոլոր տեքստային արժեքները փոխարինում է թվային արժեքով:

Sub ConvertToNumbers()
Dim rng As Range
'get constants in selected range
On Error Resume Next
Set rng = Selection _
  .SpecialCells(xlCellTypeConstants, 23)
On Error GoTo errHandler
If Not rng Is Nothing Then
  'copy blank cell outside used range
  Cells.SpecialCells(xlCellTypeLastCell) _
      .Offset(0, 1).Copy
  'add to selected cells
   rng.PasteSpecial Paste:=xlPasteValues, _
       Operation:=xlPasteSpecialOperationAdd
Else
  MsgBox "Could not find Constants in selection"
End If
exitHandler:
  Application.CutCopyMode = False
  Set rng = Nothing
  Exit Sub
errHandler:
  MsgBox "Could not change text to numbers"
  Resume exitHandler
End Sub