Attribute VB_Name = "CashPlanWork"
' ProtectSheet
Function ProtectSheet(ByVal nMode As Long, ByVal oSheet As Worksheet) As Long
    Dim cWord As String
    
    On Error GoTo ErrMsg

    cWord = ScriptGet(oSheet, "protect_word")
    nMode = VBA.IIf(cWord = "", 0, nMode)
    Select Case nMode
    Case 1
        If VBA.Val(Application.Version) <= 9 Then
            oSheet.Protect Password:=cWord, DrawingObjects:=True, Contents:=True, Scenarios:=True
        End If
        If VBA.Val(Application.Version) > 9 Then
            Call ProtectSheet9(oSheet, cWord)
        End If
    Case 2
        oSheet.Unprotect Password:=cWord
    End Select
    
    ProtectSheet = nMode
    Exit Function

ErrMsg:
    ProtectSheet = 0
    Call VBA.MsgBox("Íîìåð: " + VBA.str(Err.Number) + VBA.vbNewLine _
        + "Èñòî÷íèê: " + Err.Source + VBA.vbNewLine _
        + "Îïèñàíèå: " + Err.Description, VBA.vbOKOnly + VBA.vbCritical, "Îøèáêà")
End Function
' ProtectSheet9
Sub ProtectSheet9(ByVal oSheet As Worksheet, ByVal cWord As String)
    oSheet.Protect Password:=cWord, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
End Sub
' RowAppend
Sub RowAppend(ByVal oSheet As Worksheet, ByVal oRange As Range)
    Dim nRow As Long, nCnt As Long, cTerm1 As String, cTerm2 As String
    
    If ProtectSheet(2, oSheet) = 0 Then
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    oSheet.Rows(oRange.Row + 1).Insert
    oSheet.Rows(oRange.Row).Copy
    oSheet.Rows(oRange.Row + 1).PasteSpecial
    oSheet.Rows(oRange.Row + 1).Hidden = False
    oSheet.Rows(oRange.Row + 1).Cells(1, 1).Select
    oSheet.Rows(oRange.Row + 1).Cells(1, 1).Value = "ÓÄÀËÈÒÜ"
    Application.CutCopyMode = False
    
    nRow = oRange.Row
    While oSheet.Cells(nRow + 1, 1).Value = "ÓÄÀËÈÒÜ"
        nRow = nRow + 1
    Wend
    
    If nRow <> oRange.Row Then
        cTerm1 = "$" + VBA.Trim(VBA.str(oRange.Row))
        cTerm2 = "$" + VBA.Trim(VBA.str(nRow))
        For nCnt = 1 To oSheet.Scripts.Count
            If VBA.Right(VBA.Trim(oSheet.Scripts(nCnt).ID), VBA.Len(cTerm1)) = cTerm1 Then
                Call ScriptSet(oSheet, VBA.Replace(oSheet.Scripts(nCnt).ID, cTerm1, cTerm2), oSheet.Scripts(nCnt).ScriptText)
            End If
        Next nCnt
    End If
    
    Call ProtectSheet(1, oSheet)
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
' RowDelete
Sub RowDelete(ByVal oSheet As Worksheet, ByVal oRange As Range)
    Dim nRow As Long, nCnt As Long, cTerm As String, aID() As String, nID As Long
    
    If ProtectSheet(2, oSheet) = 0 Then
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    nRow = oRange.Row
    While oSheet.Cells(nRow + 1, 1).Value = "ÓÄÀËÈÒÜ"
        nRow = nRow + 1
    Wend
    
    nID = 0
    ReDim Preserve aID(nID)
    cTerm = "$" + VBA.Trim(VBA.str(nRow))
    For nCnt = 1 To oSheet.Scripts.Count
        If VBA.Right(VBA.Trim(oSheet.Scripts(nCnt).ID), VBA.Len(cTerm)) = cTerm Then
            nID = nID + 1
            ReDim Preserve aID(nID)
            aID(nID) = oSheet.Scripts(nCnt).ID
        End If
    Next nCnt

    For nCnt = 1 To nID
        oSheet.Scripts(aID(nCnt)).Delete
    Next nCnt
    oSheet.Rows(oRange.Row).Delete
    
    Call ProtectSheet(1, oSheet)
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
' ScriptExists
Function ScriptExists(ByVal oSheet As Worksheet, ByVal cIDScript As String) As Boolean
    Dim bRes As Boolean, n As Long
    
    bRes = False
    cIDScript = VBA.Trim(cIDScript)
    
    For n = 1 To oSheet.Scripts.Count
        If VBA.UCase(VBA.Trim(oSheet.Scripts(n).ID)) = VBA.UCase(VBA.Trim(cIDScript)) Then
            bRes = True
        End If
    Next n
    
    ScriptExists = bRes
End Function
' ScriptGet
Function ScriptGet(ByVal oSheet As Worksheet, ByVal cIDScript As String) As String
    Dim cRes As String

    cRes = ""
    cIDScript = VBA.Trim(cIDScript)
    
    If ScriptExists(oSheet, cIDScript) Then
        cRes = VBA.Trim(oSheet.Scripts(cIDScript).ScriptText)
    End If
    
    ScriptGet = cRes
End Function
' ScriptSet
Sub ScriptSet(ByVal oSheet As Worksheet, ByVal cIDScript As String, ByVal cValueScript As String)
    cIDScript = VBA.Trim(cIDScript)
    cValueScript = VBA.Trim(cValueScript)
    
    If Not ScriptExists(oSheet, cIDScript) Then
        oSheet.Scripts.Add Location:=2, Language:=2, ID:=cIDScript, ScriptText:=cValueScript
    Else
        oSheet.Scripts(cIDScript).ScriptText = cValueScript
    End If
End Sub

