Attribute VB_Name = "admin_tools"
Public updateBookName As String, repFileName As String

'Выполняет Update структуры бланка (формулы и алгоритмы не обновляются)
'Файл обновления - XLT - файл, содержащий листы с соответствующими именами и необходимые именованные диапазоны
Option Explicit


Public Sub BlankUpdate()
Dim saveBookName As String, i As Variant, name As String
    repFileName = "c:\update_report.txt"
    
    saveBookName = ActiveWorkbook.name
    If Application.Dialogs(xlDialogOpen).Show = True Then
        updateBookName = ActiveWorkbook.name
        Application.Workbooks(saveBookName).Activate
        Open repFileName For Output As #1
        For Each i In Application.Workbooks(updateBookName).Sheets
            Application.Workbooks(saveBookName).Sheets(i.name).Select
            Call REMOVE_STR(i.name)
            Call ADD_NEW_STR(i.name)
            Call CHECK_STR_NAMES(i.name)
            If VBA.Trim(Application.Workbooks(updateBookName).Sheets(i.name).Range("F1").Text) <> "" Then
                Call autoForm(Application.Workbooks(updateBookName), i.name, Application.Workbooks(updateBookName).Sheets(i.name).Range("F1").value)
            End If
        Next
        Close #1
    End If
End Sub

Sub REMOVE_STR(sheetName As String)
Dim i As Integer
    Application.StatusBar = "Подождите ... Идет удаление лишних строк ..."
    Print #1, "Список кодов удаленных строк: "
    With Application.Workbooks(updateBookName).Sheets(Sheets("service").Range("B19").Text)
        For i = Sheets("Service").Range("C5") To Sheets("Service").Range("A9")
            If GetBlankStrNum(getCode(i)) = 0 And i <= Sheets("Service").Range("A9") Then
                Sheets(Sheets("service").Range("B19").Text).Range("C" + VBA.Trim(VBA.str(i))).Select
                Print #1, " " + getCode(i)
                Call DELETESTRING(False)
                i = i - 1
            End If
        Next
    End With

    Sheets("Service").Range("A9") = ActiveWorkbook.Names("FOOTER_" + VBA.Trim(VBA.str(Sheets("service").Range("B20")))).RefersToRange.row - 1
    Application.StatusBar = ""
End Sub

'добавляет отсутствующие строки (начиная с низа). Добавляются только строки с кодом.
Sub ADD_NEW_STR(sheetName As String)
Dim code As String, row As Integer, i As Integer, j As Integer
    Application.StatusBar = "Подождите ... Идет добавление новых строк ..."
    Print #1, ""
    Print #1, "Список кодов добавленных строк: "
    With Application.Workbooks(updateBookName).Sheets(Sheets("service").Range("B19").Text)
        For i = .Range("E1") To .Range("D1") Step -1
            code = GET_CODE_BLANK(i)
            row = getStrNum(code)
            If row = 0 And code <> "" Then 'найдена строка с отсутствующим кодом
                j = i + 1
                While GET_CODE_BLANK(j) = "" And j <= .Range("E1"): j = j + 1: Wend
                If GET_CODE_BLANK(j) <> "" Then
                    j = getStrNum(GET_CODE_BLANK(j))
                    Sheets(Sheets("service").Range("B19").Text).Range("C" + VBA.Trim(VBA.str(j))).Select
                    Print #1, " " + code
                    'снять защиту
                    Sheets(Sheets("service").Range("B19").Text).Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                    Sheets(Sheets("service").Range("B19").Text).Rows(ActiveCell.row).Insert
                    'link
                    Sheets(Sheets("service").Range("B19").Text).Cells(ActiveCell.row, 1) = Sheets(Sheets("service").Range("B19").Text).Range("A1") + 1
                    'раздел
                    'Sheets(Sheets("service").Range("B19").Text).Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                    Sheets(Sheets("service").Range("B19").Text).Cells(ActiveCell.row, 2) = .Cells(i, 1)
                    For j = 3 To Sheets("service").Range("C6")
'                        Sheets(Sheets("service").Range("B19").Text).Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                        Sheets(Sheets("service").Range("B19").Text).Cells(ActiveCell.row, j) = .Cells(i, j - 1).Text
                        .Cells(i, j - 1).Copy
                        Sheets(Sheets("service").Range("B19").Text).Cells(ActiveCell.row, j).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                            False, Transpose:=False
                    Next
                    Call READDRESS_FORMULA(ActiveCell.row, True)
                    Sheets(Sheets("service").Range("B19").Text).Rows(ActiveCell.row).AutoFit 'автоподбор высоты ячейки
                    Sheets(Sheets("service").Range("B19").Text).Cells(ActiveCell.row, 3).Interior.ColorIndex = 35
                    'поставить защиту
                    Sheets(Sheets("service").Range("B19").Text).Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
                Else
                    Print #1, "Строка с кодом " + code + " не добавлена !!!"
                End If
            End If
        Next
    End With
    Sheets("Service").Range("A9") = ActiveWorkbook.Names("FOOTER_" + VBA.Trim(VBA.str(Sheets("service").Range("B20")))).RefersToRange.row - 1
    Application.StatusBar = ""
End Sub

Sub CHECK_STR_NAMES(sheetName As String)
Dim i As Integer, j As Integer, k As Integer
    Application.StatusBar = "Подождите ... Идет коррекция существующих строк бланка ..."
    With Application.Workbooks(updateBookName).Sheets(Sheets("service").Range("B19").Text)
        j = .Range("D1")
        For i = Sheets("Service").Range("C5") To Sheets("Service").Range("A9")
            If Sheets(Sheets("service").Range("B19").Text).Cells(i, 1).value > 0 Then
                While GET_CODE_BLANK(j) = "" And j <= .Range("E1"): j = j + 1: Wend
                If GET_CODE_BLANK(j) <> getCode(i) Then
                    Print #1, "Несоответствие порядка следования кодов: " + getCode(i) + " и " + GET_CODE_BLANK(j)
                    'снять защиту
                    Sheets(Sheets("service").Range("B19").Text).Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                    Sheets(Sheets("service").Range("B19").Text).Cells(i, 3).Interior.ColorIndex = 5
                Else
                    For k = 3 To Sheets("service").Range("C6")
                        If VBA.Trim(Sheets(Sheets("service").Range("B19").Text).Cells(i, k).Text) <> VBA.Trim(.Cells(j, -1 + k)) Then
                            Print #1, "Несоответствие значений, код строки " + getCode(i)
                            Sheets(Sheets("service").Range("B19").Text).Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                            Sheets(Sheets("service").Range("B19").Text).Cells(i, k) = VBA.Trim(.Cells(j, -1 + k).Text)
                            Sheets(Sheets("service").Range("B19").Text).Cells(i, 3).Interior.ColorIndex = 6
                        End If
                    Next
                    j = j + 1
                End If
            Else
             '   Print #1, "Код " + getCode(i) + " не найден в бланке !!!"
            End If
        Next
    End With
    Application.StatusBar = ""
End Sub

'возвращает код строки с заданным номером (в файле обновления)
Function GET_CODE_BLANK(row As Integer) As String
Dim i As Integer, tempStr As String
    tempStr = ""
    For i = 1 To Sheets("service").Range("B22")
        With Application.Workbooks(updateBookName).Sheets(Sheets("service").Range("B19").Text)
            If VBA.Val(.Cells(row, .Range("B1") + i - 1).Text) = 0 And (i > 1) Then GoTo fff
            tempStr = tempStr + VBA.Trim(.Cells(row, .Range("B1") + i - 1).Text)
        End With
    Next
fff:
    GET_CODE_BLANK = tempStr
End Function

'возвращает номер строки с заданным кодом (в файле обновления)
Public Function GetBlankStrNum(code As String) As Integer
Dim i As Integer
    With Application.Workbooks(updateBookName).Sheets(Sheets("service").Range("B19").Text)
        For i = .Range("D1") To .Range("E1")
            If Trim(code) = Trim(GET_CODE_BLANK(i)) Then
                GetBlankStrNum = i
                GoTo ppp
            End If
        Next
    End With
    GetBlankStrNum = 0
ppp:
End Function


'возвращает код из строки target
Public Function getCode1(ByVal target As Long) As String
    Dim lSheetsService, lSheetsReport, temp, i, pnAddress_Col
    
    Set lSheetsService = Sheets("Service")
    Set lSheetsReport = Sheets(Sheets("Service").Range("B19").Text)
    temp = ""
    pnAddress_Col = Sheets("Service").Range("C6")
    If lSheetsService.Range("B22").value = 1 Then
       temp = lSheetsReport.Cells(target, pnAddress_Col - lSheetsService.Range(lSheetsService.Range("E1")))
    Else
       temp = ""
       For i = 0 To lSheetsService.Range("E4") - 1
           If (VBA.Val(lSheetsReport.Cells(target, pnAddress_Col - lSheetsService.Range(lSheetsService.Range("E1")) + i)) = 0) And (i > 0) Then GoTo fff
           temp = temp + lSheetsReport.Cells(target, pnAddress_Col - lSheetsService.Range(lSheetsService.Range("E1")) + i)
       Next
    End If
fff:
    getCode1 = temp

End Function



Public Function Blank_Balans()
Dim i As Integer, sheetsService As Worksheet, sheetsReport As Worksheet, SheetsCond, sheetsAlg
Dim mainSheets As Worksheet
Dim lnColumn1, lnRow1, row11, col11, j, cond_row, cond_col, alg_row, alg_col, str As String

Set sheetsService = Sheets("Service")
Set sheetsAlg = Sheets("ALG")
Set SheetsCond = Sheets("OTBOR_COND")
Set mainSheets = Sheets(sheetsService.Range("B19").Text)

With sheetsService.Range("KRIT_RAZDEL")
     lnColumn1 = .column
     lnRow1 = .row
End With

row11 = sheetsService.Range("KRIT_GRAF").row
col11 = sheetsService.Range("KRIT_GRAF").column
alg_row = sheetsAlg.Range("KRIT_ALG").row
alg_col = sheetsAlg.Range("KRIT_ALG").column

cond_row = SheetsCond.Range("KRIT_STR_cond").row
cond_col = SheetsCond.Range("KRIT_STR_cond").column

For i = 1 To sheetsService.Range("B23")
    ' установим страницу
    ' зададим критерий
    sheetsService.Cells(lnRow1 + 1, lnColumn1) = i
    If sheetsService.Range("B23") = 1 Then
        Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Range("B19").Text)
    Else
        Set sheetsReport = Application.ActiveWorkbook.Sheets(sheetsService.Cells(lnRow1 + 3, lnColumn1).Text)
    End If
    
    sheetsReport.Activate
    For j = sheetsService.Range("C5") To sheetsService.Range("A9")
        If sheetsReport.Cells(j, 1) <> 0 Then
            sheetsAlg.Cells(alg_row + 1, alg_col) = sheetsReport.Cells(j, 1)
            If sheetsAlg.Cells(alg_row + 2, alg_col + 1) = 0 And sheetsAlg.Cells(alg_row + 2, alg_col + 2) = 0 Then 'алг. есть
                If sheetsAlg.Cells(alg_row + 2, alg_col) = 0 Then 'алг. по формуле
            
                Else
                    str = getCode(j) + Space(10 - Len(getCode(j)))
                    SheetsCond.Cells(cond_row + 1, cond_col) = sheetsReport.Cells(j, 1)
                    If SheetsCond.Cells(cond_row + 2, cond_col + 1) <> 1 Then
                        str = str + "   |   " + SheetsCond.Cells(cond_row + 8, cond_col) + Space(150 - Len(SheetsCond.Cells(cond_row + 8, cond_col)))
                        If SheetsCond.Cells(cond_row + 9, cond_col + 1) = 0 Then str = str + "   |   " + SheetsCond.Cells(cond_row + 9, cond_col) + Space(30 - Len(SheetsCond.Cells(cond_row + 9, cond_col)))
                    End If
                End If
            End If
        End If
    Next
Next
    
End Function

Public Function getColumnNumber(letter As String, Optional pName As String = "") As Integer
Dim oldRep, klCol As Integer, kstCol As Integer, pageName As String
    pageName = pName
    Set oldRep = Sheets(Sheets("Service").Range("B19").Text)
    If pageName <> "" Then
        Sheets(pageName).Select
    Else
        pageName = Sheets("Service").Range("B19").Text
    End If
    Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = ""
    Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 1) = letter
    Sheets("Service").Cells(KRIT_GRAF_ROW + 2, KRIT_GRAF_COLUMN + 1).CALCULATE
    getColumnNumber = Sheets("Service").Cells(KRIT_GRAF_ROW + 2, KRIT_GRAF_COLUMN + 1)
    Sheets("Service").Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 1) = ""
    oldRep.Select
    
End Function
