Sub KomPred(wbold As Workbook, load_pic As String)
    Application.Calculation = xlCalculationManual
    Dim flag As Boolean

70  Application.ScreenUpdating = False
80  With Sheets(gsSTART_NAME).Range("C22")
90  End With
100 With Sheets(gsSMETA_NAME)
        Dim lr As Integer
110     lr = .Range(gsONES_COLUMN_SMETA & .Rows.Count).End(xlUp).Row
120     .Range("$A$11:$Z$" & lr).AutoFilter Field:=giONES_COLUMN_FILTER
130     .Range("filter_p").Value = 2
140     .Unprotect Password:="5029"
150 End With
160 Sheets(Array(gsMENU_NAME, gsMAIN_NAME, gsSMETA_NAME, gsOPTION_NAME, gsABOUT_NAME)).Copy    '!!!1

170 wbold.Worksheets(gsSMETA_NAME).Protect Password:="5029", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True

180 Sheets(gsABOUT_NAME).Visible = True

    Dim wbKP As Workbook                         ', vbc As VBComponent
190 Set wbKP = ActiveWorkbook

200 With wbKP
210     .PrecisionAsDisplayed = True             'точность, как на экране

220     With .Worksheets(gsMAIN_NAME)            '!!!
230         Range2Value .Range("A1:B50")
240         Range2Value .Range("C1:C15")
250         Range2Value .Range("Opisanie_fundament")
260         Range2Value .Range("C25")
270         .PageSetup.PrintArea = "$A$1:$C$49"

280     End With


290     With .Worksheets(gsABOUT_NAME)           ' О НАС
300         .Activate
310         .Range("B3").Select
320         ActiveWindow.DisplayHeadings = False
330         ActiveWindow.DisplayGridlines = False
340         .UsedRange
350     End With

360     With .Worksheets(gsMENU_NAME)            'МЕНЮ
370         .Activate
380         Range2Value .Range("C10:F10")
390         ActiveWindow.DisplayHeadings = False
400         ActiveWindow.DisplayGridlines = False
410         .Range("D16").Select
420         .UsedRange
430     End With


440     With .Worksheets(gsSMETA_NAME)           ' СМЕТА
            Dim tsmeta
            Dim lrrrr
            lrrrr = lr - 66

450         tsmeta = .Range("U7")
460         .Activate
470         .Range("A6").Value = "КОММЕРЧЕСКОЕ ПРЕДЛОЖЕНИЕ"
480         .Unprotect Password:="5029"
            .Range("BA9:BD9").Cut
            Range("D8").Select
            ActiveSheet.Paste

            '            .Range("K7") = .Range("K1")
490         Range2Value .Range("S10:S" & lr)
500         Range2Value .Range("A9:B" & lr)
            '            .Range("K1") = "ЛОЖЬ"
510         Range2Value .Range("D9:E" & lr)
            '            .Range("K1") = .Range("K7")
520         .Range("M8").Value = .Range("U9")
530         Range2Value .Range("A2:M8")
540         Range2Value .Range("J11:J" & lr)
550         Range2Value .Range("R11:W" & lr)
551         Range2Value .Range("X11:X" & lrrrr)
            '560               Range2Value .Range("M11:M" & lr)
570         Range2Value .Range("del_raschet_stat")
            '            Range2Value .Range("del_minvata")
            '            Range2Value .Range("del_sofit")
580         Range2Value .Range("del_s")
590         .Rows("11").Delete
            '            del_Shapes .Shapes
            .Shapes("Ф_доп_системы").Delete
600         .DropDowns.Delete
610         .Buttons.Delete
            Dim col As Collection
620         get_collection_checkbox Worksheets(gsSMETA_NAME), col
            Dim r As Integer
            Dim rngG As Range
630         For r = 9 To lr
640             If .Range(gsONES_COLUMN_SMETA & r).Value = 0 Then
650                 On Error Resume Next
660                 col(CStr(r)).Delete
670                 On Error GoTo 0
680                 If rngG Is Nothing Then
690                     Set rngG = .Range("A" & r)
700                 Else
710                     Set rngG = Union(.Range("A" & r), rngG)
720                 End If
730             End If
740         Next
750         If Not rngG Is Nothing Then
760             rngG.EntireRow.Delete
770         End If

            Dim h
780         On Error Resume Next
790         For Each h In .Hyperlinks
800             h.Range.Style = "Hyperlink"
810         Next
820         With ActiveWorkbook.Styles("Hyperlink").Font
830             .Name = "Arial Narrow"
840             .Size = 11
850             .Bold = False
860             .Italic = True
870             .Underline = xlUnderlineStyleNone
880             .Strikethrough = False
890             .Color = -131072
900             .TintAndShade = 0
910             .ThemeFont = xlThemeFontNone
920         End With
930         On Error GoTo 0

940         ActiveWindow.FreezePanes = False
950         With ActiveWindow
960             .SplitColumn = 0
970             .SplitRow = 1
980         End With
990         ActiveWindow.FreezePanes = True
            '            ActiveWindow.DisplayHeadings = False
1000        .Outline.ShowLevels RowLevels:=1, ColumnLevels:=2
1010        .EnableOutlining = True
1020        .CheckBoxes.Visible = True


1030        .Columns("N").Resize(, .UsedRange.Columns.Count).Delete    'Victor

1050        If tsmeta = 1 Then
1060            .Outline.ShowLevels RowLevels:=2, ColumnLevels:=2
                '            .PageSetup.PrintArea = "$A$2:$I$" & lr2
1070            .PageSetup.LeftMargin = Application.InchesToPoints(0.236220472440945)
1080            .PageSetup.RightMargin = Application.InchesToPoints(0.236220472440945)
1090            .PageSetup.TopMargin = Application.InchesToPoints(0.590551181102362)
1100            .PageSetup.BottomMargin = Application.InchesToPoints(0.590551181102362)
1110            .PageSetup.HeaderMargin = Application.InchesToPoints(0.31496062992126)
1120            .PageSetup.FooterMargin = Application.InchesToPoints(0.31496062992126)
1130            .PageSetup.CenterHorizontally = True
1140            .PageSetup.FitToPagesWide = 1
1150            .PageSetup.FitToPagesTall = False
1160            .PageSetup.Orientation = xlLandscape
1170        Else
1180            .Outline.ShowLevels RowLevels:=1, ColumnLevels:=2
1190            .PageSetup.LeftFooter = "ПОДРЯДЧИК: ______________________________"
1200            .PageSetup.CenterFooter = "Страница &P из &N"
1210            .PageSetup.RightFooter = "ЗАКАЗЧИК: ______________________________"
1220            .PageSetup.LeftMargin = Application.InchesToPoints(0.236220472440945)
1230            .PageSetup.RightMargin = Application.InchesToPoints(0.236220472440945)
1240            .PageSetup.TopMargin = Application.InchesToPoints(0.47244094488189)
1250            .PageSetup.BottomMargin = Application.InchesToPoints(0.47244094488189)
1260            .PageSetup.HeaderMargin = Application.InchesToPoints(0.31496062992126)
1270            .PageSetup.FooterMargin = Application.InchesToPoints(0.31496062992126)
1280            .PageSetup.CenterHorizontally = True
1290            .PageSetup.Zoom = False
1300            .PageSetup.FitToPagesWide = 1
1310            .PageSetup.FitToPagesTall = False
1320            .PageSetup.Orientation = xlPortrait
                'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
                .Rows(8).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                With .Range("A8:I8")
                    .Font.Bold = True
                    .Font.ThemeColor = xlThemeColorAccent2
                    .Font.TintAndShade = -0.499984740745262
                    .Interior.Color = 13500415
                    .HorizontalAlignment = xlCenter
                    .MergeCells = True
                    .Cells(1).Value = "ЧТОБЫ ПОЛНОСТЬЮ ОТКРЫТЬ ПОДРОБНУЮ СМЕТУ СВЯЖИТЕСЬ С НАШИМИ СПЕЦИАЛИСТАМИ!"
                End With

                'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

1690        End If

            Dim chb As CheckBox, arCheckBox
            Dim colOffset&, i&
1700        ReDim arCheckBox(1 To .CheckBoxes.Count, 1 To 2)
1710        wbKP.Sheets.Add After:=wbKP.Sheets(wbKP.Sheets.Count)
1720        wbKP.Sheets(wbKP.Sheets.Count).Name = "В"
1730        wbKP.Sheets(wbKP.Sheets.Count).Visible = 2    'Victor
'.Activate
1740        colOffset = 1 - .Columns("J:M").Column
1750        For Each chb In .CheckBoxes
1760            i = i + 1
1770            Set arCheckBox(i, 1) = chb
1780            arCheckBox(i, 2) = wbKP.Sheets(wbKP.Sheets.Count).Name & "!" & Range(chb.LinkedCell).Offset(, colOffset).Address
1790        Next
1800        .Columns("J:M").Cut
1810        wbKP.Sheets(wbKP.Sheets.Count).Range("A1").Insert
1820        For i = 1 To UBound(arCheckBox)
1830
                arCheckBox(i, 1).LinkedCell = arCheckBox(i, 2)
1840        Next
            ' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


            Dim lr3&
1850        If .AutoFilterMode Then .Range("A1").AutoFilter
1860        lr3 = .Columns(1).Find("ОБЩИЙ ИТОГ ПО ВСЕЙ СМЕТЕ").Row
1870        .Range("A9:A" & lr3).AutoFilter

            Dim nm As Name
1890        On Error Resume Next             'Victor
1880        For Each nm In Names
1900            nm.Delete
1910        Next nm
            On Error GoTo 0
1920        .Columns("O:AO").Copy
1930        .Columns("J:J").Insert Shift:=xlToRight

            Dim lr2 As Integer
1940        lr2 = .Range("I" & .Rows.Count).End(xlUp).Row
1950        .PageSetup.PrintArea = "$A$2:$I$" & lr2

1960        ActiveWindow.ScrollRow = 1
1970        ActiveWindow.ScrollColumn = 1
            '                  .Range("I8").Select
1980        ActiveWindow.FreezePanes = True
1990        ActiveWindow.DisplayGridlines = False
2000        .Range("J2:J7").RowHeight = 20.25
2010        If tsmeta = 0 Then
2020            .Range("J6:J7").RowHeight = 30.25
2030        End If

            Dim sOptions$
            Dim chk As Excel.CheckBox

2050        For Each chk In .CheckBoxes
2060            sOptions$ = sOptions$ & "," & chk.LinkedCell
2070        Next
2080        sOptions = Mid(sOptions, 2)
.Activate
                .Range("D9:G9").Cut
                .Range("J1").Select
                .Paste
                .Range("J1").VerticalAlignment = xlCenter


            ' ^^^^^^^^^^^^ РАЗМЕТКА ДЛЯ ПЕЧАТИ ^^^^^^^^^^^^^^^
'            Dim lrPrintArea&, LocRow&, HPBCounter&, prevLocRow&, nextLocRow&
'            '    Application.ScreenUpdating = False
'            ActiveWindow.View = xlPageBreakPreview
'            '    With ActiveSheet
'            On Error Resume Next
''            ar = Sheets(2).UsedRange.Value
'            ar = ThisWorkbook.Sheets(1).Range("D1").CurrentRegion.Value ' список раскрываемых строк
'
'            lrPrintArea = .Range(.PageSetup.PrintArea).Rows.Count + .Range(.PageSetup.PrintArea).Row - 1
'            '        s = "Монтаж металлочерепицы"
'            For i = 1 To lrPrintArea
'                For j = 1 To UBound(ar)
'                    If .Cells(i, 1).Value = ar(j, 1) Then
'                        .Rows(i).ShowDetail = True
'                    End If
'                Next
'            Next
'            If Err Then Err.Clear
'            .ResetAllPageBreaks
'            HPBCounter = 1
'            LocRow = .HPageBreaks(HPBCounter).Location.Row
'            lrPrintArea = .Range(.PageSetup.PrintArea).Rows.Count + .Range(.PageSetup.PrintArea).Row - 1
'
'            For i = 1 To lrPrintArea
'                If .Cells(i, 1).Value = "НАИМЕНОВАНИЕ" Or i = lrPrintArea Then
'                    If LocRow < i Then
'                        nextLocRow = i
'                        Set .HPageBreaks(HPBCounter).Location = .Range("A" & prevLocRow)
'                        HPBCounter = HPBCounter + 1
'                        LocRow = .HPageBreaks(HPBCounter).Location.Row
'                        prevLocRow = nextLocRow
'                        If Err Then Err.Clear: Exit For
'                    Else
'                        prevLocRow = i
'                    End If
'
'                End If
'            Next
'            '    End With
'            ActiveWindow.View = xlNormalView
'            On Error GoTo 0
            ' ^^^^^^^^^^^^ РАЗМЕТКА ДЛЯ ПЕЧАТИ ^^^^^^^^^^^^^^^

2090        .UsedRange

2100    End With           ' СМЕТА
2110    With .Worksheets(gsOPTION_NAME)          ' ОПЦИИ
            Dim shp As Shape, s$, delRange As Range
2120        .Activate
2130        For Each shp In .Shapes
2140            If TypeName(shp.DrawingObject) = "CheckBox" Then
2150                If InStr(sOptions, Mid(shp.DrawingObject.LinkedCell, InStr(shp.DrawingObject.LinkedCell, "!") + 1)) = 0 Then
2160                    s = s & "," & shp.TopLeftCell.Address
2170                    shp.Delete
2180                End If
2190            Else
                    '                    shp.Delete
2200                If shp.Type <> msoComment Then
2210                    shp.Delete
2220                End If
2230            End If
2240        Next
2250        s = Mid(s, 2)
DoEvents
'On Error Resume Next
Application.Wait (Now + TimeValue("0:00:05"))
2260        Set delRange = .Range(s) 'Nothing
22600        Set delRange = delRange.EntireRow 'Nothing
2261        delRange.Delete
'2260        .Range(s).EntireRow.Delete
2270        .Columns("J").Resize(, .UsedRange.Columns.Count).Delete
2280        ActiveWindow.DisplayHeadings = False
2290        ActiveWindow.DisplayGridlines = False
2300        ActiveWindow.ScrollColumn = 1

2310        .Range("C5").Select
2320        .UsedRange
2330    End With

2340    With .Worksheets(gsMAIN_NAME)            '!!! блок перенесн поскольку не удалялись строки с пустыми галками пол добавления гиперссылки
2350        On Error Resume Next                 'Victor
2360        .Range("C4").Hyperlinks.Add .Range("C4"), wbold.Sheets("СТАРТ").Range("C20").Value, TextToDisplay:=wbold.Sheets("СТАРТ").Range("F20").Value
2370        On Error GoTo 0
2380    End With

2390    .Worksheets("МЕНЮ").Select
2400    Application.ScreenUpdating = True



        Call LinksDel

2480    .Sheets("ОБЩАЯ").Name = "ПРОСТАЯ СМЕТА"
2490    .Sheets("СМЕТА").Name = "ПОДРОБНАЯ СМЕТА"
        Dim TextMSG$
        Dim wb As Workbook
        Set wb = wbKP
2500    If Len(load_pic) Then

2510        Call NewPictureSheet(load_pic, wb, TextMSG)    '  Call NewPictureSheet(load_pic, wbKP)

2520    End If
2530    .Activate
2540    With .Sheets("МЕНЮ")
2550        .Select
2560        .Range("D18:D19").Hyperlinks(1).SubAddress = "'ПРОСТАЯ СМЕТА'!C7"
            '    Range("D21:D22").Select
2570        .Range("D21:D22").Hyperlinks(1).SubAddress = "'ПОДРОБНАЯ СМЕТА'!A8"
            '    Range("D24:D25").Select
2580        .Range("D24:D25").Copy
            '    Range("D18:D19").Select
2590        .Range("D18:D19").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                                           SkipBlanks:=False, Transpose:=False
            '    Range("D21:D22").Select
2600        .Range("D21:D22").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                                           SkipBlanks:=False, Transpose:=False
2610        Application.CutCopyMode = False
2620        .Range("A1").Select

2630    End With
        '        Debug.Print .Name

2640 End With                                    'wbKP
    Application.ScreenUpdating = True

    '2650      Application.ScreenUpdating = True
    '        Debug.Print "КП1 - " & ActiveWorkbook.Name
    '            If TextMSG <> "" Then MsgBox TextMSG 'Вывод сообщения о количестве загруженных изображений
    '        Debug.Print "КП2 - " & ActiveWorkbook.Name

    Application.Calculation = xlCalculationAutomatic
End Sub