Attribute VB_Name = "auto_Form"
Option Explicit

Public Function getLink(code As String, Optional Razdel As Integer = 0) As Integer
Dim i As Integer
Dim firstScr As Integer
    firstScr = 0
    For i = Sheets("Service").Range("C5") To Sheets("Service").Range("A9")
        If (Trim(code) = Trim(getCode(i))) And (Razdel = 0 Or Razdel = Sheets(Sheets("Service").Range("B19").Text).Cells(i, 2)) Then
            If Sheets(Sheets("Service").Range("B19").Text).Cells(i, 2) = Razdel Or Razdel = 0 Then
                firstScr = Sheets(Sheets("Service").Range("B19").Text).Cells(i, 1)
                GoTo ppp
            End If
        Else
            If Sheets(Sheets("Service").Range("B19").Text).Cells(i, 2) = Razdel And firstScr = 0 Then firstScr = Sheets(Sheets("Service").Range("B19").Text).Cells(i, 1)
        End If
    Next
ppp:
    getLink = firstScr
End Function

Public Function getStrNum(code As String, Optional Razdel As Integer = 0) As Integer
Dim i As Integer
Dim firstScr As Integer
    firstScr = 0
    For i = Sheets("Service").Range("C5") To Sheets("Service").Range("A9")
        If (Trim(code) = Trim(getCode(i))) And (Razdel = 0 Or Razdel = Sheets(Sheets("Service").Range("B19").Text).Cells(i, 2)) Then
            If Sheets(Sheets("Service").Range("B19").Text).Cells(i, 2) = Razdel Or Razdel = 0 Then
                firstScr = i
                GoTo ppp
            End If
        Else
            If (Trim(code) = Trim(getCode(i))) And firstScr = 0 Then firstScr = i
        End If
    Next
ppp:
    getStrNum = firstScr
End Function

Public Function getNextNum(ByRef str As String) As String
Dim out As String
    out = ""
    str = VBA.Trim(str)
    While Mid(str, 1, 1) >= "0" And Mid(str, 1, 1) <= "9"
        out = out + Mid(str, 1, 1)
        str = Right(str, Len(str) - 1)
    Wend
    getNextNum = out
End Function

'mode=0 - ">","<","="
'mode=1 - "+","-"
Public Function getZnak(ByRef str As String, mode As Integer) As String
Dim out As String
    out = ""
    str = VBA.Trim(str)
    While ((Mid(str, 1, 1) = ">" Or Mid(str, 1, 1) = "<" Or Mid(str, 1, 1) = "=") And (mode = 0)) Or _
            ((Mid(str, 1, 1) = "+" Or Mid(str, 1, 1) = "-" And (mode = 1)))
        out = out + Mid(str, 1, 1)
        'If out = ">" Then Stop
        str = Right(str, Len(str) - 1)
    Wend
    getZnak = out
End Function

'удаление формулы и (или) алгоритма, если есть
Public Sub delForm(bar As Integer)
    Dim i As Integer, sheet
    i = 2
    While VBA.Trim(Sheets("FORM").Cells(i, 1).Text) <> ""
        If Sheets("FORM").Cells(i, 1).value = bar Then
            If (Sheets("Service").Range("B23") = 1) Or (Sheets("FORM").Cells(i, 8).value = Sheets("Service").Range("B20")) Then
                Sheets("FORM").Range(Sheets("FORM").Cells(i, 1), Sheets("FORM").Cells(i, 8)).Delete Shift:=xlUp
            End If
        End If
        i = i + 1
    Wend
    i = 2
    While VBA.Trim(Sheets("ALG").Cells(i, 1).Text) <> ""
        If Sheets("ALG").Cells(i, 1).value = bar Then
            If (Sheets("Service").Range("B23") = 1) Or (Sheets("ALG").Cells(i, 6).value = Sheets("Service").Range("B20")) Then
                Sheets("ALG").Range(Sheets("ALG").Cells(i, 1), Sheets("ALG").Cells(i, 6)).Delete Shift:=xlUp
            End If
        End If
        i = i + 1
    Wend
    i = 2
    While VBA.Trim(Sheets("OTBOR_COND").Cells(i, 1).Text) <> ""
        If Sheets("OTBOR_COND").Cells(i, 1).value = bar Then
            If (Sheets("Service").Range("B23") = 1) Or (Sheets("OTBOR_COND").Cells(i, 6).value = Sheets("Service").Range("B20")) Then
                Sheets("OTBOR_COND").Range(Sheets("OTBOR_COND").Cells(i, 1), Sheets("OTBOR_COND").Cells(i, 9)).Delete Shift:=xlUp
            End If
        End If
        i = i + 1
    Wend
End Sub

'R1 - столбец формул (на FORM)
Sub autoForm(Optional bookName As Variant = Nothing, Optional sheetName As Variant = "FORM", Optional column As Variant = 18)
Dim i As Integer, r As Range, row As Integer, z As String
Dim form As String, temp As String, str As String, znak As String, book
Dim nLink As Integer

    Application.StatusBar = "Подождите ... Идет обновление формул ..."
    Call init_data
    i = 1
    KRIT_ZNAK_ROW = Sheets("Service").Range("KRIT_ZNAK").row
    KRIT_ZNAK_COLUMN = Sheets("Service").Range("KRIT_ZNAK").column
    If bookName Is Nothing Then Set bookName = ActiveWorkbook
    
    If sheetName <> "FORM" Then
        Print #1, "Обновление формул:"
    End If
    
    While VBA.Trim(bookName.Sheets(sheetName).Cells(i, column)) <> ""
        Application.StatusBar = "Подождите ... Идет обновление формул ..."
        str = VBA.Trim(bookName.Sheets(sheetName).Cells(i, column))
        temp = getNextNum(str)
        znak = getZnak(str, 0)
        
        nLink = getLink(temp)
        If nLink <> 0 Then
            Call delForm(nLink)
            Set r = Sheets("Form").Columns(1).Find("", LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows)
            row = r.row
            
            Sheets("Form").Cells(row, 1) = nLink
            Sheets("Form").Cells(row, 2) = 0
            If row = 2 Then
                Sheets("Form").Cells(row, 3) = 1
            Else
'                Sheets("Form").Visible = True
                Sheets("Form").Cells(row, 3) = Sheets("Form").Cells(row - 1, 3) + 1
            End If
            While Trim(str) <> ""
                z = getZnak(str, 1)
                temp = getNextNum(str)
                nLink = getStrNum(temp)
                If nLink <> 0 Then
                    Sheets("Form").Cells(row, 4) = Sheets("Form").Cells(row, 4) + " " + IIf(Trim(z) = "", "+", Trim(z)) + " "
                    Sheets("Form").Cells(row, 4) = Sheets("Form").Cells(row, 4) + "@$" + Trim(VBA.str(nLink))
                Else
                    If sheetName <> "FORM" Then
                        Print #1, "  не найден код " + temp + " формула " + VBA.Trim(bookName.Sheets(sheetName).Cells(i, column))
                    End If
                End If
            Wend
            Sheets("Form").Cells(row, 4) = Sheets("Form").Cells(row, 4) + " "
            Sheets("Service").Cells(KRIT_ZNAK_ROW + 1, KRIT_ZNAK_COLUMN) = ""
            Sheets("Service").Cells(KRIT_ZNAK_ROW + 1, KRIT_ZNAK_COLUMN + 1) = """" + Trim(znak) + """"
            Sheets("Form").Cells(row, 5) = Sheets("Service").Cells(KRIT_ZNAK_ROW + 2, KRIT_ZNAK_COLUMN + 1)
            Sheets("Form").Cells(row, 6).FormulaLocal = "=СТРОКА()"
            Sheets("Form").Cells(row, 7) = 1
            Sheets("Form").Cells(row, 8) = Sheets("Service").Range("B20")
            
            If znak = "=" Then
            'добавим алгоритм
            With Sheets("ALG")
                ' Сброс критерия поиска
                .Range(.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""
                .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN) = Sheets("Form").Cells(row, 1)
                .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + 1) = 0
                If .Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 1) = 0 And .Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 2) = 0 Then ' Запись есть
                Else
                    If Sheets("Form").Cells(row, 5) = 1 Then Call WORK_TABLE_ALG(Sheets("Form").Cells(row, 1), 0, 0, Sheets("Form").Cells(row, 3), 0, 1)
                End If
            End With
            End If
            row = row + 1
        Else
            If sheetName <> "FORM" Then
                Print #1, "  не найден код " + temp + " формула " + VBA.Trim(bookName.Sheets(sheetName).Cells(i, column))
            End If
        End If
        
        i = i + 1
    Wend
    With Sheets("ALG")
        ' Сброс критерия поиска
        .Range(.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""
    End With
    Application.StatusBar = False
End Sub

Public Sub addForm(formStr As String, Razdel As Integer)
Dim i As Integer, r As Range, row As Integer, z As String
Dim form As String, temp As String, str As String, znak As String, book
Dim tmpLink As Integer
Dim tmpStr As String, kl As Integer, kst As Integer

    KRIT_ZNAK_ROW = Sheets("Service").Range("KRIT_ZNAK").row
    KRIT_ZNAK_COLUMN = Sheets("Service").Range("KRIT_ZNAK").column
        
    tmpStr = formStr
    kl = VBA.Val(getNextNum(formStr))
    kst = VBA.Val(getNextNum(formStr))
    znak = getZnak(formStr, 0)
        
    tmpLink = getFintehLink(kl, kst)
    Call delForm(tmpLink)
    Set r = Sheets("Form").Columns(1).Find("", LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows)
    row = r.row
    
'    If VBA.Trim(temp) = "0400" Then
'        Stop
'    End If
'    tmpLink = getLink(temp, Razdel)
    If tmpLink <> 0 Then
        Sheets("Form").Cells(row, 1) = tmpLink
            
        Sheets("Form").Cells(row, 2) = 0
        If row = 2 Then
            Sheets("Form").Cells(row, 3) = 1
        Else
            Sheets("Form").Cells(row, 3) = Sheets("Form").Cells(row - 1, 3) + 1
        End If
        While Trim(formStr) <> ""
            z = getZnak(formStr, 1)
            kl = VBA.Val(getNextNum(formStr))
            kst = VBA.Val(getNextNum(formStr))
            
            tmpLink = getFintehLink(kl, kst, 1)
            
            If tmpLink <> 0 Then
                Sheets("Form").Cells(row, 4) = Sheets("Form").Cells(row, 4) + " " + IIf(Trim(z) = "", "+", Trim(z)) + " "
                Sheets("Form").Cells(row, 4) = Sheets("Form").Cells(row, 4) + "@$" + Trim(VBA.str(tmpLink))
            Else
                Print #1, "  не найден код KL = " + VBA.str(kl) + ", KST = " + VBA.str(kst) + " формула " + VBA.Trim(tmpStr)
            End If
        Wend
        Sheets("Form").Cells(row, 4) = Sheets("Form").Cells(row, 4) + " "
        Sheets("Service").Cells(KRIT_ZNAK_ROW + 1, KRIT_ZNAK_COLUMN) = ""
        Sheets("Service").Cells(KRIT_ZNAK_ROW + 1, KRIT_ZNAK_COLUMN + 1) = """" + Trim(znak) + """"
        Sheets("Form").Cells(row, 5) = Sheets("Service").Cells(KRIT_ZNAK_ROW + 2, KRIT_ZNAK_COLUMN + 1)
        Sheets("Form").Cells(row, 6).FormulaLocal = "=СТРОКА()"
        Sheets("Form").Cells(row, 7) = 1
        Sheets("Form").Cells(row, 8) = Sheets("Service").Range("B20")
        
        If znak = "=" Then
            'добавим алгоритм
            With Sheets("ALG")
                ' Сброс критерия поиска
                .Range(.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""
                .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN) = Sheets("Form").Cells(row, 1)
                .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + 1) = 0
                If .Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 1) = 0 And .Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 2) = 0 Then ' Запись есть
                Else
                    If Sheets("Form").Cells(row, 5) = 1 Then Call WORK_TABLE_ALG(Sheets("Form").Cells(row, 1), 0, 0, Sheets("Form").Cells(row, 3), 0, 1)
                End If
            End With
        End If
        With Sheets("ALG")
            ' Сброс критерия поиска
            .Range(.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""
        End With
        Application.StatusBar = False
    Else
        Print #1, "  не найден код " + temp + " формула " + VBA.Trim(tmpStr)
    End If
End Sub

Public Sub addForm_mdc(formStr As String, Razdel As Integer)
Dim i As Integer, r As Range, row As Integer, z As String
Dim form As String, temp As String, str As String, znak As String, book
Dim tmpLink As Integer
Dim tmpStr As String, kl As Integer, kst As Integer
Dim col As Integer
Dim page As String, oldSheets As Worksheet

    KRIT_ZNAK_ROW = Sheets("Service").Range("KRIT_ZNAK").row
    KRIT_ZNAK_COLUMN = Sheets("Service").Range("KRIT_ZNAK").column
        
    tmpStr = formStr
    kl = VBA.Val(getNextNum(formStr))
    kst = VBA.Val(getNextNum(formStr))
    col = VBA.Val(getNextNum(formStr))
    znak = getZnak(formStr, 0)
        
    tmpLink = getFintehLink(kl, kst)
'    Call delForm(tmpLink)
    Set r = Sheets("Form").Columns(1).Find("", LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByRows)
    row = r.row
    
    Set oldSheets = Sheets(Sheets("service").Range("B19").Text)
'    If VBA.Trim(temp) = "0400" Then
'        Stop
'    End If
'    tmpLink = getLink(temp, Razdel)
    If tmpLink <> 0 Then
        Sheets("Form").Cells(row, 1) = tmpLink
            
        Sheets("Form").Cells(row, 2) = col
        If row = 2 Then
            Sheets("Form").Cells(row, 3) = 1
        Else
            Sheets("Form").Cells(row, 3) = Sheets("Form").Cells(row - 1, 3) + 1
        End If
        While Trim(formStr) <> ""
            kl = VBA.Val(getNextNum(formStr))
            If kl = 0 Then
                page = getNextSubstr(formStr, " ")
                kl = VBA.Val(getNextNum(formStr))
            Else
                page = ""
            End If
            
            kst = VBA.Val(getNextNum(formStr))
            col = VBA.Val(getNextNum(formStr))
            z = getZnak(formStr, 1)
            
            If page <> "" Then
                Sheets(page).Activate
            End If
            tmpLink = getFintehLink(kl, kst, 1)
            
            If tmpLink <> 0 Then
                Sheets("Form").Cells(row, 4) = Sheets("Form").Cells(row, 4) + " " + IIf(Trim(z) = "", "+", Trim(z)) + " "
                If page <> "" Then
                    Sheets("Form").Cells(row, 4) = Sheets("Form").Cells(row, 4) + page + "!"
                End If
                Sheets("Form").Cells(row, 4) = Sheets("Form").Cells(row, 4) + letArr(Sheets("Service").Range("B20")).data(col) + "$" + Trim(VBA.str(tmpLink))
            Else
                Print #1, "  не найден код KL = " + VBA.str(kl) + ", KST = " + VBA.str(kst) + " формула " + VBA.Trim(tmpStr)
            End If
            
            If page <> "" Then
                oldSheets.Activate
            End If
            
        Wend
        
        Sheets("Form").Cells(row, 4) = Sheets("Form").Cells(row, 4) + " "
        Sheets("Service").Cells(KRIT_ZNAK_ROW + 1, KRIT_ZNAK_COLUMN) = ""
        Sheets("Service").Cells(KRIT_ZNAK_ROW + 1, KRIT_ZNAK_COLUMN + 1) = """" + Trim(znak) + """"
        Sheets("Form").Cells(row, 5) = Sheets("Service").Cells(KRIT_ZNAK_ROW + 2, KRIT_ZNAK_COLUMN + 1)
        Sheets("Form").Cells(row, 6).FormulaLocal = "=СТРОКА()"
        Sheets("Form").Cells(row, 7) = 2
        Sheets("Form").Cells(row, 8) = Sheets("Service").Range("B20")
        
        If znak = "44444444444444444444444444" Then
            'добавим алгоритм
            With Sheets("ALG")
                ' Сброс критерия поиска
                .Range(.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""
                .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN) = Sheets("Form").Cells(row, 1)
                .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + 1) = 0
                If .Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 1) = 0 And .Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 2) = 0 Then ' Запись есть
                Else
                    If Sheets("Form").Cells(row, 5) = 1 Then Call WORK_TABLE_ALG(Sheets("Form").Cells(row, 1), 0, 0, Sheets("Form").Cells(row, 3), 0, 1)
                End If
            End With
        End If
        With Sheets("ALG")
            ' Сброс критерия поиска
            .Range(.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""
        End With
        Application.StatusBar = False
    Else
        Print #1, "  не найден код " + temp + " формула " + VBA.Trim(tmpStr)
    End If
End Sub

Public Sub addAlg()
Dim i As Integer, r As Range, row As Integer, z As String
Dim form As String, temp As String, str As String, znak As String
    
    row = 116
    While VBA.Trim(Sheets("Form").Cells(row, 1)) <> ""
        
        'добавим алгоритм
        With Sheets("ALG")
            ' Сброс критерия поиска
            .Range(.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""
            .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN) = Sheets("Form").Cells(row, 1)
            .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + 1) = 0
            If .Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 1) = 0 And .Cells(KRIT_ALG_ROW + 2, KRIT_ALG_COLUMN + 2) = 0 Then ' Запись есть
            Else
                If Sheets("Form").Cells(row, 5) = 1 Then Call WORK_TABLE_ALG(Sheets("Form").Cells(row, 1), 0, 0, Sheets("Form").Cells(row, 3), 0, 1)
            End If
        End With
        
        row = row + 1
    Wend
    With Sheets("ALG")
        ' Сброс критерия поиска
        .Range(.Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN), .Cells(KRIT_ALG_ROW + 1, KRIT_ALG_COLUMN + KRIT_ALG_COLUMNCOUNT - 2)) = ""
    End With
End Sub

'Обновление link-ов алгоритмов
Public Sub ggg()
Dim i
    i = 1
    While Sheets("OTBOR_COND").Range("T" + Trim(str(i))).Text <> ""
        Sheets("OTBOR_COND").Range("U" + Trim(str(i))) = getLink(Sheets("OTBOR_COND").Range("T" + Trim(str(i))).Text)
        i = i + 1
    Wend
End Sub

