Редактирование шаблонов выходных документов

[Timur]

искал в макросах

по частям поищите...может получиться...

[arbeiten]

искал в макросах

по частям поищите...может получиться...

Искал в файле LS_TSN.XLS, ничего. (экспортирую в ТСН-2001, 11 граф).

[Timur]

Искал в файле LS_TSN.XLS

у меня находит...не знаю чем еще помочь тогда.

[arbeiten]

Искал в файле LS_TSN.XLS

у меня находит...не знаю чем еще помочь тогда.

Вот текст макроса из LS_TSN.XLS:

Код: Выделить всё

'  Lascaiate ogni speranza, voi ch'entrata!
'  (Leave behind every hope, you who enter!)
'
'  -- Dante
'
'  Оставь надежду, всяк сюда входящий! Данте.
'

Option Explicit

'Константы для прогресса выполнения
Const sPBuild = "Построение "
Const sPInitParams = "Инициализация параметров документа "
Const sPProcessSmStr = "Обработка сметных строк "
Const sPTab = sPProcessSmStr & "шифр расценки: "
Const sPHeaderDoc = sPBuild & "шапки документа "
Const sPItogGraf = sPBuild & "итогов по графам на "
Const sPLimItog = sPBuild & "лимитированных итогов на "
Const sPResVed = sPBuild & "ресурсной ведомости на "
Const sPItogVidRab = sPBuild & "итогов по видам работ на "
Const sPUnionNRSP = "Укрупнение процентов НР и СП по видам работ на "

Const Start_Boady = 1

Const sFontName = "Arial"
Const iSizeFont = 11

Const PrmRoundIt = 1
Const PrmRoundEd = 2

Dim PercentEd As Integer
Dim PercentIt As Integer

Public Const csIndexLevel_1 = 1
Public Const csIndexLevel_2 = 2

Const CalcItBase = 3 'Расчитать всего в базовом уровне цен
Const PZ = 1 'ПЗ
Const Mat = 2 'Матер
Const EMM = 3 'ЭММ
Const ZPM = 4 'ЗПМ
Const OZP = 5 'ОЗП
Const NR = 6  'НР
Const SP = 7  'СП

'Константы для рассчета итогов
Const ColIt_B = 15     'стоимость 2001 г по сметной строке
Const ColIt_C = 16     'стоимость текущая г по сметной строке

Const ColIt_NR_B = 17  'стоимость 2001 г Накладные расходы от ФОТ
Const ColIt_NR_C = 18  'стоимость текущий Накладные расходы от ФОТ
Const ColIt_SP_B = 19  'стоимость 2001 г Сметная прибыль
Const ColIt_SP_C = 20  'стоимость текущий Сметная прибыль
Const ColIt_NR_SP_ZPM_B = 21  'стоимость 2001 г НР и СП от ЗПМ
Const ColIt_NR_SP_ZPM_C = 22  'стоимость текущая НР и СП от ЗПМ
Const ColIt_FOT_B = 23 'стоимость 2001 г зарплата машинистов

Const ColIt_Stroit_B = 24  'стоимость 2001 г строительных работ
Const ColIt_Mont_B = 25    'стоимость 2001 г монтажных работ
Const ColIt_Oborud_B = 26  'стоимость 2001 г оборудования
Const ColIt_Other_B = 27   'стоимость 2001 г прочих работ

Const xWrapHeader = 30
Const xWrapStruct = 31
Const xWrapItogName = 32
Const xWrapLimTitle = 33
Const xWrapLimNames = 34
Const xWrapRRTitle = 35
Const xWrapRRName = 36

Dim xNpp As Integer
Dim xTab As Integer
Dim xName As Integer
Dim xEdIzm As Integer
Dim xKoll As Integer
Dim xEdCen As Integer
Dim xPopr As Integer
Dim xZU As Integer
Dim xItogB As Integer
Dim xIndex As Integer
Dim xItogC As Integer

Public PrmPrintRR As Boolean
Public PrmPrintRRInStruct As Boolean
Public PrmPrintRRTrud As Boolean
Public PrmPrintRRMash As Boolean
Public PrmPrintRRMat As Boolean
Public PrmPrintRRPriceInfo As Boolean
Public PrmPrintRRZeroStr  As Boolean
Public PrmPrintRRNegativeValue As Boolean

Public PrmPrintTitle As Boolean
Public PrmPortret As Boolean
Public DocTwoLevel  As Boolean
Public PrmAltTab As Integer  ' 1-Альтернативное; 2-Обычное; 3-Альтернативное сокр.
Public PrmHeaderUtv As Boolean
Public PrmHeaderOnLs As Boolean
Public PrmPrintNppSubStr As Boolean
Public PrmPrintZeroStr As Boolean
Public PrmPrintZeroInfo As Boolean
Public PrmPrintFormulaInKoll As Boolean
Public PrmPrintComment As Boolean
Public PrmPrintReplacePopr As Boolean
Public PrmPrintKodPopr As Boolean
Public PrmPrintCorrectPopr As Boolean
Public PrmFullEdIzm As Boolean
Public PrmPrintItog As Boolean
Public PrmPrintLimItog As Boolean
Public PrmPrintItogObj As Boolean '[CQ 11482]
Public PrmPrintFooter As Boolean
Public PrmPrintCompens As Boolean
Public PrmPrintItogVidRab As Boolean
Public PrmPrintCalcResultBCost As Boolean
Public PrmPrintIndicateExcludeStr As Boolean

Public PrmSelectedLevelIndex As Long 'csIndexLevel_1 или csIndexLevel_2
Public PrmIdLevelCost As Long

Dim DocType As Long
Dim NmGraf As Integer
Dim NumPP As Long

Dim yLS As Long      'Начало локальной сметы (для расчета итога по структуре)
Dim yRazd As Long    'Начало раздела (для расчета итога по структуре)
Dim yPodRazd As Long 'Начало подраздела (для расчета итога по структуре)

Dim yStartSmStr As Long  'Начало сметной строки (для расчета итога по сметной строке)
Dim yStartSubStr As Long 'Начало подчиненной строки (для расчета итога по сметной строке)
Dim sySmStr As Long      'Координата на текущую сметную строку

Dim y_header As Long
Dim header_cnt As Long

Dim syCount As Long

Dim UseAkt As Boolean

Dim Src As Excel.Worksheet
Dim dst As Excel.Worksheet

Dim TmpSheet As Excel.Worksheet

Const SmetaUtilsBook = "SmetaUtils.xls"
Dim WBSmetaUtils As Excel.Workbook

Sub DoLs_TSN()

  If Not IsDocumentCorrect Then Exit Sub
 
  DocType = 0
 
  'Восстанавливаем значения на форме
  On Error GoTo RestoreError
    Application.Run ("SmetaUtils.xls!RestoreForm"), Form_Tsn, DocType, "DoLs_TSN"
  On Error GoTo 0
   
RestoreError:
  Form_Tsn.Caption = "Смета по ТСН-2001 (ОАО МЦЦС 'Мосстройцены')"
 
  CustomizeForm
  Form_Tsn.Show
     
  'Сохраняем значения на форме
  On Error GoTo SaveError
    Application.Run ("SmetaUtils.xls!SaveForm"), Form_Tsn, DocType, "DoLs_TSN"
  On Error GoTo 0
 
  CloseSmetaUtils
           
SaveError:
  Application.ScreenUpdating = True
End Sub

Sub DoAkt_TSN()

  If Not IsDocumentCorrect Then Exit Sub
 
  DocType = 1
 
  'Восстанавливаем значения на форме
  On Error GoTo RestoreError
    Application.Run ("SmetaUtils.xls!RestoreForm"), Form_Tsn, DocType, "DoAkt_TSN"
  On Error GoTo 0
   
RestoreError:
  Form_Tsn.Caption = "Акт по ТСН-2001 (ОАО МЦЦС 'Мосстройцены')"
 
  CustomizeForm
  Form_Tsn.Show
     
  'Сохраняем значения на форме
  On Error GoTo SaveError
    Application.Run ("SmetaUtils.xls!SaveForm"), Form_Tsn, DocType, "DoAkt_TSN"
  On Error GoTo 0
 
  CloseSmetaUtils
           
SaveError:
  Application.ScreenUpdating = True
End Sub

Sub DoKC2_TSN()

  If Not IsDocumentCorrect Then Exit Sub
 
  DocType = 2
 
  'Восстанавливаем значения на форме
  On Error GoTo RestoreError
    Application.Run ("SmetaUtils.xls!RestoreForm"), Form_Tsn, DocType, "DoKC2_TSN"
  On Error GoTo 0
   
RestoreError:
  Form_Tsn.Caption = "Акт КС-2 по ТСН-2001 (ОАО МЦЦС 'Мосстройцены')"
 
  CustomizeForm
  Form_Tsn.Show
     
  'Сохраняем значения на форме
  On Error GoTo SaveError
    Application.Run ("SmetaUtils.xls!SaveForm"), Form_Tsn, DocType, "DoKC2_TSN"
  On Error GoTo 0
 
  CloseSmetaUtils
           
SaveError:
  Application.ScreenUpdating = True
End Sub

Sub CustomizeForm()
Dim syLevel As Long

  Set Src = ActiveWorkbook.Sheets("Source")
 
  With Form_Tsn
   
    FormProgress.InitProgress Src
   
    .Tag = Src.Cells(1, 7).Value '0-Smeta.ru; 1-BabyСмета; 2-НормоКалькулятор; 3-АтомСмета
   
     UpdateButton
     
    'Базовый уровень
    syLevel = Application.Run("SmetaUtils.xls!FindLevel", csIndexLevel_1)
    If syLevel <> 0 Then
      .OBLevelBase.Caption = Application.Run("SmetaUtils.xls!GetLevelTitle", syLevel, 0)
    End If
    .OBLevelBase.Value = syLevel <> 0
    .OBLevelBase.Visible = syLevel <> 0
   
    'Текущий уровень
    syLevel = Application.Run("SmetaUtils.xls!FindLevel", csIndexLevel_2)
    If syLevel <> 0 Then
      .OBLevelCurr.Caption = Application.Run("SmetaUtils.xls!GetLevelTitle", syLevel, 0)
    End If
    .OBLevelCurr.Value = syLevel <> 0
    .OBLevelCurr.Visible = syLevel <> 0
       
    .CBPrintCompens.Enabled = Application.Run("SmetaUtils.xls!IsCompens")
 
  End With

End Sub

Sub UpdateButton()
Dim aProjectType As Integer

  With Form_Tsn
   
    .FrameUtv.Enabled = (DocType = 0)
    .OBUtv.Enabled = (DocType = 0)
    .OBNotUtv.Enabled = (DocType = 0)
   
    .CBItogVidRab.Value = (DocType = 0)
    .CBItogVidRab.Enabled = (DocType = 0)
   
    .CBPrintRRInStruct.Enabled = .CBRR.Value
    .CBPrintRRTrud.Enabled = .CBRR.Value
    .CBPrintRRMash.Enabled = .CBRR.Value
    .CBPrintRRMat.Enabled = .CBRR.Value
    .CBPrintRRZeroStr.Enabled = .CBRR.Value
    .CBPrintRRNegativeValue.Enabled = .CBRR.Value
    .LabelUnionParamRR.Enabled = .CBRR.Value
   
    aProjectType = .Tag  '-1 not inited; 0 Smeta.ru; 1 BabyСмета; 2 НормоКалькулятор; 3 АтомСмета
    If aProjectType <> -1 Then
   
      If aProjectType = 1 Then 'BabyСмета
     
        .CBPrintPriceInfo.Value = False
        .CBPrintPriceInfo.Enabled = False
       
        .CBHeaderOnLS.Enabled = False
        .CBHeaderOnLS.Value = True
      Else
'        .CBPrintPriceInfo.Enabled = .CBRR.Value And _
'                                    .CBPrintRRMat.Value And _
'                                    ((aProjectType = 0) Or (aProjectType = 3))
                                   
        'TODO
        .CBPrintPriceInfo.Value = False
        .CBPrintPriceInfo.Enabled = False
      End If
    End If

  End With
End Sub

Function IsDocumentCorrect() As Boolean
 
  On Error GoTo SourceNotFound
   
    IsDocumentCorrect = True
   
    With Worksheets("Source")
       If ((.Cells(1, 1).Value <> 0) Or _
             ((.Cells(1, 4).Value <> "_PS_") And _
              (.Cells(1, 4).Value <> "_RS_")) _
        ) Then
          MsgBox ("Неверный тип документа!")
          IsDocumentCorrect = False
          Exit Function
       End If
    End With
   
    If Not OpenSmetaUtils Then
      IsDocumentCorrect = False
      Exit Function
    End If
   
    Exit Function
   
SourceNotFound:
   Application.ScreenUpdating = True
   IsDocumentCorrect = False
   MsgBox ("Не тот документ!")
End Function

Sub FormatStructStr(ByVal y As Long)
Dim Rng As Range
 
  With dst
   
    Set Rng = .Range(.Cells(y, 1), .Cells(y, NmGraf))
   
    SetFont Rng, iSizeFont + 2
    With Rng
      .HorizontalAlignment = xlCenter
      .Font.Bold = True
      .Merge
      .WrapText = True
    End With
   
  End With
 
  WrapLongName xWrapStruct, y

End Sub

Function GetSheetName() As String
  If DocType = 0 Then
    GetSheetName = "Смета по ТСН-2001"
  ElseIf DocType = 1 Then
    GetSheetName = "Акт по ТСН-2001"
  ElseIf DocType = 2 Then
    GetSheetName = "Акт КС-2 по ТСН-2001"
  End If
End Function

Sub InitGlobalVars()
Dim syLevel As Long
 
  Set Src = ActiveWorkbook.Sheets("Source")
  syCount = Src.Cells.SpecialCells(xlCellTypeLastCell).Row
 
  FormProgress.UpdateProgress sPInitParams, 12
 
  PrmIdLevelCost = 0
  If (PrmSelectedLevelIndex = csIndexLevel_1) Or (PrmSelectedLevelIndex = csIndexLevel_2) Then
    syLevel = Application.Run("SmetaUtils.xls!FindLevel", PrmSelectedLevelIndex)
    If syLevel <> 0 Then
      PrmIdLevelCost = Src.Cells(syLevel, 14).Value
      Application.Run ("SmetaUtils.xls!InitModulFormuls"), PZ, Mat, EMM, ZPM, OZP, NR, SP, syLevel
    End If
  End If
 
  Application.Run ("SmetaUtils.xls!AddSheet"), GetSheetName
  Set dst = Application.ActiveSheet
 
  With Src
    If (.Cells(15, 1) = 15) Or (.Cells(15, 1) = 16) Then
      UseAkt = False
    Else
      UseAkt = True
    End If
  End With
 
  PercentEd = Application.Run("SmetaUtils.xls!RoundParam", PrmRoundEd)
  PercentIt = Application.Run("SmetaUtils.xls!RoundParam", PrmRoundIt)
  NumPP = 0
 
  'Смета МТСН и АКТ МТСН
  If (DocType = 0) Or (DocType = 1) Then
   
    NmGraf = 11
   
    xNpp = 1
    xTab = 2
    xName = 3
    xEdIzm = 4
    xKoll = 5
    xEdCen = 6
    xPopr = 7
    xZU = 8
       
    If DocTwoLevel Then
     xItogB = 9
     xIndex = 10
    Else
     xItogB = 0
     xIndex = 9
    End If
   
    xItogC = xIndex + 1
   
  'АКТ КС-2 МТСН
  ElseIf (DocType = 2) Then
   
    NmGraf = 12
   
    xNpp = 1
    xTab = 3
    xName = 4
    xEdIzm = 5
    xKoll = 6
    xEdCen = 7
    xPopr = 8
    xZU = 9
       
    If DocTwoLevel Then
     xItogB = 10
     xIndex = 11
    Else
     xItogB = 0
     xIndex = 10
    End If
   
    xItogC = xIndex + 1
 
  End If
   
  header_cnt = 0
  y_header = 0
 
  sySmStr = 0
 
  InitRR
   
End Sub

Sub SetColumnsWidth()
 
  With dst
       
    .Columns(xNpp).ColumnWidth = 5     'Номер по порядку
    .Columns(xTab).ColumnWidth = 14    'Обоснование
    .Columns(xName).ColumnWidth = 40 'Наименование 'CQ[10894]
    .Columns(xEdIzm).ColumnWidth = 8  'Единица измерения
    .Columns(xKoll).ColumnWidth = 11   'Кол-во
    .Columns(xEdCen).ColumnWidth = 11  'Цена на ед. изм. руб.
    .Columns(xPopr).ColumnWidth = 16   'Поправки
    .Columns(xIndex).ColumnWidth = 12   'коэффиц. пересчета
    .Columns(xItogC).ColumnWidth = 12   'ВСЕГО в текущих (прогнозных) ценах, руб.
    If DocTwoLevel Then
      .Columns(xZU).ColumnWidth = 10    'ЗУ
      .Columns(xItogB).ColumnWidth = 12 'ВСЕГО в базисных ценах, руб.
    Else
      .Columns(xItogC + 1).ColumnWidth = 12 'Ст-ть ед. с начислен.
    End If
   
    'Смета по ТСН, Акт по ТСН
    If (DocType = 0) Or (DocType = 1) Then
     
      If PrmPortret Then
        .PageSetup.Orientation = xlPortrait
        .PageSetup.Zoom = 60  'CQ[10894]
      Else
        .PageSetup.Orientation = xlLandscape
        .PageSetup.Zoom = 90  'CQ[10894]
      End If
     
    'Акт КС-2 по ТСН
    ElseIf (DocType = 2) Then
     
      .Columns(xNpp + 1).ColumnWidth = 5  'Номер по порядку
   
      If PrmPortret Then
        .PageSetup.Orientation = xlPortrait
        .PageSetup.Zoom = 60  'CQ[10894]
      Else
        .PageSetup.Orientation = xlLandscape
        .PageSetup.Zoom = 85  'CQ[10894]
      End If
    End If
   
    Dim sHeader As String
      sHeader = Src.Cells(1, 10).Value
     
    .PageSetup.LeftHeader = "&8" + sHeader
    .PageSetup.RightFooter = "&P"
   
    .PageSetup.LeftMargin = Application.InchesToPoints(0.4)   '1.0см
    .PageSetup.RightMargin = Application.InchesToPoints(0.2)  '0.5см  'CQ[10895]
    If sHeader = "" Then
      .PageSetup.TopMargin = Application.InchesToPoints(0.2)    '0.5см
    Else
      .PageSetup.TopMargin = Application.InchesToPoints(0.4)    '1.0см
    End If
    .PageSetup.BottomMargin = Application.InchesToPoints(0.4) '1.0см 'CQ[11127]
    .PageSetup.FooterMargin = Application.InchesToPoints(0.2) '0.5см
    .PageSetup.HeaderMargin = Application.InchesToPoints(0.2) '0.5см
   
    .Range(.Cells(1, 1), .Cells(1, NmGraf + 4)).Select
    ActiveWindow.Zoom = True
     
  End With
End Sub

Sub RunТСН()
Dim y As Long   ' current row in new sheet
Dim sy As Long  ' current row in source
Dim LsNumber As Long
Dim aTypeStr As Variant

 InitGlobalVars
   
 y = Start_Boady ' current row in new sheet
 sy = 12          ' current row in source
           
   With dst
   
     On Error GoTo ErrPrinter
         
       SetColumnsWidth
             
ErrPrinter:
     
     On Error GoTo 0
     
     Do While ((sy <= syCount) And (Src.Cells(sy, 1).Value <> "-1"))
       aTypeStr = Src.Cells(sy, 1).Value
         
       If (aTypeStr <> "") Then   ' Skip empty strings
         
         If Src.Cells(sy, 2).Value > 0 Then  ' Skip unvisible strings
           
           If aTypeStr = "1" Then
             
             If Not PrmHeaderOnLs Then
               PrintLocalHeaders y, sy
             End If
             
           ElseIf aTypeStr = "3" Then

              If PrmHeaderOnLs Then
                If LsNumber <> 0 Then
                  PrintFooters y
                 
                  .HPageBreaks.Add Before:=Cells(y, 1)
                End If
                LsNumber = LsNumber + 1
               
                PrintLocalHeaders y, sy
              Else
                PrintStructure y, sy
              End If

           ElseIf (aTypeStr = "4") Or (aTypeStr = "5") Then
             
              PrintStructure y, sy
             
           ElseIf aTypeStr = "19" Then
             
              PrintComment y, sy
           
           ElseIf aTypeStr = "17" Or aTypeStr = "18" Then
             
              PrintSmetaStr y, sy
                   
           ElseIf ((aTypeStr = "51")) Then  ' Limitir. string
                   
              PrintItogStruct y, sy, GetStructElem(sy)
              PrintLimitir y, sy
              PrintRV y, sy
             
           End If
         
         End If
       
       End If
       
       FormProgress.UpdateProgress sPProcessSmStr, sy
       sy = sy + 1 ' Next row in source
       
     Loop

     PrintFooters y
     
     OnArterPrintering y
     
  End With
 
End Sub

Sub OnArterPrintering(ByVal y As Long)
Dim I As Integer

On Error GoTo ErrPrinter1

  With dst
     
    '.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(y, NmGraf)).Address
   
    For I = ColIt_B To xWrapRRName
      .Columns(I).Hidden = True
    Next I
 
  End With
 
ErrPrinter1:
 
End Sub

Sub InitRangeFooter(ByRef aRangeFooter As String)
  'Смета по МТСН
  If (DocType = 0) Then
    aRangeFooter = "A62:K66"
  'Акт по МТСН
  ElseIf (DocType = 1) Then
    aRangeFooter = "A42:K46"
  'Акт КС-2 по МТСН
  ElseIf (DocType = 2) Then
    aRangeFooter = "A80:K84"
  End If
End Sub

Sub InitRangeHeaderUtv(ByRef aRangeHeaderUtv As String)
  'Смета по МТСН
  If (DocType = 0) Then
    aRangeHeaderUtv = "A1:K6"
  End If
End Sub

Sub InitRangeHeader(ByRef aRangeHeader As String)
  'Смета по МТСН
 
  If (DocType = 0) Then
   
    If DocTwoLevel Then
      aRangeHeader = "A9:K31"
    Else
      aRangeHeader = "A34:K58"
    End If
   
  'Акт по МТСН
  ElseIf (DocType = 1) Then
   
    If DocTwoLevel Then
      aRangeHeader = "A1:K19"
    Else
      aRangeHeader = "A21:K38"
    End If
   
  'Акт КС-2 по МТСН
  ElseIf (DocType = 2) Then
   
    If DocTwoLevel Then
      aRangeHeader = "A1:L37"
    Else
      aRangeHeader = "A42:L76"
    End If
  End If
End Sub

Sub InitRangeInSheet(ByRef aSheetName As String)
  'Смета по МТСН
  If (DocType = 0) Then
    aSheetName = "LS_Header_11_0"
  'Акт по МТСН
  ElseIf (DocType = 1) Then
    aSheetName = "AKT_Header_11_1"
  'Акт КС-2 по МТСН
  ElseIf (DocType = 2) Then
    aSheetName = "KC2_Header_12_2"
  End If
End Sub

Sub PrintComment(ByRef y As Long, ByVal sy As Long)
  If PrmPrintComment Then
    With dst
      .Cells(y, xName).Formula = "=Source!G" + Trim(Str(sy))
      FormatComment y
      y = y + 1
    End With
  End If
End Sub

Sub FormatComment(ByVal y As Long)
 
  With dst
   
    .Cells(y, xName).WrapText = True
    SetFont .Cells(y, xName), iSizeFont
    .Cells(y, xName).Font.Italic = True
     
  End With
End Sub

Sub FormatSmetaStr(ByVal y As Long)
Dim Rng As Range

With dst
   
   SetFont .Range(.Cells(y, 1), .Cells(y, NmGraf)), iSizeFont
   
   'Акт КС-2 по МТСН
   If DocType = 2 Then
     Set Rng = .Range(.Cells(y, xNpp), .Cells(y, xNpp + 1))
   Else
     Set Rng = .Cells(y, xNpp)
   End If
   
   With Rng
      .HorizontalAlignment = xlLeft
      .VerticalAlignment = xlTop
   End With
   
   Set Rng = .Range(.Cells(y, xTab), .Cells(y, xName))
   With Rng
     .HorizontalAlignment = xlLeft
     .VerticalAlignment = xlTop
     .WrapText = True
   End With
   
   Set Rng = .Cells(y, xEdIzm)
   With Rng
      .HorizontalAlignment = xlLeft
      .VerticalAlignment = xlBottom
      .WrapText = True
   End With
   
   Set Rng = .Range(.Cells(y, xEdIzm + 1), .Cells(y, NmGraf))
   With Rng
      .HorizontalAlignment = xlRight
      .VerticalAlignment = xlBottom
   End With
                   
  .Cells(y, xEdIzm).Font.Italic = True
  .Cells(y, xEdIzm).HorizontalAlignment = xlRight
 
  .Cells(y, xPopr).HorizontalAlignment = xlRight
  .Cells(y, xPopr).WrapText = True
 
  .Cells(y, xEdCen).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", PercentEd)
  If DocTwoLevel Then
    .Cells(y, xItogB).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", PercentIt)
  Else
    .Cells(y, xItogC + 1).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", PercentIt)
  End If
  .Cells(y, xItogC).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", PercentIt)
 
  .Rows(y).AutoFit 'CQ[10898]
 
End With

End Sub

Function EqualFrmItPZEdPZ(ByVal sy As Long) As Boolean
  EqualFrmItPZEdPZ = (Src.Cells(sy, 192).Value = 1)
End Function

Sub PrintSmetaStr(ByRef y As Long, ByVal sy As Long)
Dim aType As Integer
Dim aIdLevel As Long
Dim aTabFixText As String
Dim aNameFixText As String
Dim ySmStr As Long

  With dst
         
    aIdLevel = Src.Cells(sy, 27).Value
    'Печатаем выбранный уровень
    If PrmIdLevelCost = aIdLevel Then
     
      aType = Src.Cells(sy, 1).Value
     
      If (PrmPrintZeroStr) Or (Src.Cells(sy, 9).Value <> 0) Then
     
         FormProgress.UpdateProgress sPTab & Src.Cells(sy, 6).Value, sy
         
         ySmStr = y
         FormatSmetaStr y
           
         If PrmPrintNppSubStr Or aType = 17 Then
            'Акт КС-2 по МТСН
            If DocType = 2 Then
              NumPP = NumPP + 1
              .Cells(y, xNpp).Value = NumPP
              .Cells(y, xNpp + 1).Formula = "=Source!E" + Trim(Str(sy))
            Else
              .Cells(y, xNpp).Formula = "=Source!E" + Trim(Str(sy))
            End If
         End If
           
          ' 1-Альтернативное; 2-Обычное; 3-Альтернативное сокр.
         If (PrmAltTab = 1) Then
           .Cells(y, xTab).Formula = "=Source!BJ" + Trim(Str(sy))
         ElseIf (PrmAltTab = 2) Then
           .Cells(y, xTab).Formula = "=Source!F" + Trim(Str(sy))
         ElseIf (PrmAltTab = 3) Then
           Application.Run ("SmetaUtils.xls!BuildNameTab"), .Cells(y, xTab), Src.Cells(sy, 6), Src.Cells(sy, 62), Src.Cells(sy, 60)
         End If
                 
         .Cells(y, xName).Formula = "=Source!G" + Trim(Str(sy))
                 
         If PrmFullEdIzm Then
           .Cells(y, xEdIzm).Formula = "=Source!DW" + Trim(Str(sy))
         Else
           .Cells(y, xEdIzm).Formula = "=Source!H" + Trim(Str(sy))
         End If
                           
         If (xKoll <> 0) Then .Cells(y, xKoll).Formula = "=Source!I" + Trim(Str(sy))
                   
         aTabFixText = .Cells(y, xTab).Value
         If (PrmPrintKodPopr) And (Src.Cells(sy, 145).Value <> "") Then
           Application.Run ("SmetaUtils.xls!KodPoprAddedInValue"), y, sy, xTab, aTabFixText
         End If
         
         'Индикация исключенных строк
         If PrmPrintIndicateExcludeStr Then  'CQ[10896]
           Application.Run ("SmetaUtils.xls!IndicateExcludeSmResAddedInValue"), y, sy, xName
         End If
         
         aNameFixText = .Cells(y, xName).Value
         If PrmPrintCorrectPopr Then
           Application.Run ("SmetaUtils.xls!CorrectPoprAddedInValue"), y, sy, xName, aNameFixText
         End If
         
         If PrmPrintCalcResultBCost Then    'CQ[10588]
           Application.Run ("SmetaUtils.xls!ResultCalcBCostAddedInValue"), y, sy, xName, aNameFixText
         End If
         
         Dim sOZPB As String
         Dim sZPMB As String
         Dim sZPMC As String
         
         sOZPB = Application.Run("SmetaUtils.xls!ItogValueB", sy, OZP)
         sZPMB = Application.Run("SmetaUtils.xls!ItogValueB", sy, ZPM)
         
         .Cells(y, ColIt_NR_B).Formula = "=ROUND((" & Application.Run("SmetaUtils.xls!NRSPValueB", sy, NR) & "/100)*" & sOZPB & "," & Str(PercentIt) & ")"
         .Cells(y, ColIt_SP_B).Formula = "=ROUND((" & Application.Run("SmetaUtils.xls!NRSPValueB", sy, SP) & "/100)*" & sOZPB & "," & Str(PercentIt) & ")"
         .Cells(y, ColIt_NR_SP_ZPM_B).Formula = "=ROUND((" & Application.Run("SmetaUtils.xls!NRSPZPMValueB") & "/100)*" & sZPMB & "," & Str(PercentIt) & ")"
         
         sZPMC = "ROUND(" & Application.Run("SmetaUtils.xls!ItogValueC", sy, ZPM) & "," & Str(PercentIt) & ")"
         .Cells(y, ColIt_NR_C).Formula = "=Source!X" + Trim(Str(sy))
         .Cells(y, ColIt_SP_C).Formula = "=Source!Y" + Trim(Str(sy))
         .Cells(y, ColIt_NR_SP_ZPM_C).Formula = "=ROUND((" & Application.Run("SmetaUtils.xls!NRSPZPMValueC") & "/100)*" & sZPMC & "," & Str(PercentIt) & ")"
                                             
         If aType = 18 Then
                   
            If yStartSubStr = 0 Then yStartSubStr = y
                   
            Dim sPoprVal As String
            sPoprVal = Application.Run("SmetaUtils.xls!PoprValCaseSubStr", sy)
                   
            'ПЗ баз.
            If Not PrmPrintReplacePopr And ((Len(sPoprVal)) > 0) And (Left(Trim(sPoprVal), 1) = "=") Then
              .Cells(y, xEdCen).Formula = "=Source!AB" + Trim(Str(sy))
            Else
              .Cells(y, xEdCen).Formula = "=Source!AK" + Trim(Str(sy))
              .Cells(y, xPopr).Value = "'" & sPoprVal
            End If
                               
            'Стоимость ПЗ + НР + СП баз.
            If DocTwoLevel Then
              .Cells(y, xItogB).Formula = "=" & Application.Run("SmetaUtils.xls!PZValueF", sy, CalcItBase)
              .Cells(y, ColIt_Oborud_B).Formula = "=IF(Source!BI" & Trim(Str(sy)) & "=3," & AbsoluteLink(y, xItogB) & ", 0)"
            End If
                                   
            'Индекс
            .Cells(y, xZU).Formula = "=" & Application.Run("SmetaUtils.xls!ZUFCaseSubStr", sy)
            .Cells(y, xIndex).Formula = "=" & Application.Run("SmetaUtils.xls!IndexFCaseSubStr", sy)
           
            'Стоимость ПЗ ит.
            .Cells(y, xItogC).Formula = "=Source!O" + Trim(Str(sy))
           
            y = y + 1
 
         ElseIf aType = "17" Then

            yStartSubStr = 0
            yStartSmStr = y
            sySmStr = sy
           
            'Если формула ПЗ ит = ПЗ ед.
            If EqualFrmItPZEdPZ(sy) Then
              .Cells(y, xEdCen).Formula = "=Source!AB" + Trim(Str(sy))
              .Cells(y, xIndex).Formula = "=Source!AZ" + Trim(Str(sy))
               If DocTwoLevel Then
                 .Cells(y, xItogB).Formula = "=" & Application.Run("SmetaUtils.xls!PZValueF", sy, CalcItBase)
               End If
               .Cells(y, xItogC).Formula = "=Source!O" + Trim(Str(sy))
            End If
           
            '==> [CQ 11321]
            If Src.Cells(sy, 60).Value = 3 Then
             
              If (PrmPrintZeroInfo) Or (Src.Cells(sy, 16).Value <> 0) Then
       
                'Мат баз.
                If (Not PrmPrintReplacePopr) And (Len(Trim(Src.Cells(sy, 108).Value)) > 0) And (Left(Trim(Src.Cells(sy, 108).Value), 1) = "=") Then
                  .Cells(y, xEdCen).Formula = "=Source!AC" + Trim(Str(sy))
                Else
                  .Cells(y, xEdCen).Formula = "=Source!AL" + Trim(Str(sy)) 'B - AL E - AC
                  .Cells(y, xPopr).Formula = "=Source!DD" + Trim(Str(sy)) 'B - AO E - AF
                End If
               
                .Cells(y, xZU).Formula = "=Source!AW" + Trim(Str(sy))
                               
                'Стоимость Мат баз.
                If DocTwoLevel Then
                  .Cells(y, xItogB).Formula = "=" & Application.Run("SmetaUtils.xls!ItogValueB", sy, Mat)
                End If
               
                'Индекс к Мат
                .Cells(y, xIndex).Formula = "=" & Application.Run("SmetaUtils.xls!IndexF", sy, Mat)
                                     
                'Стоимость Мат ит.
                .Cells(y, xItogC).Formula = "=Source!P" + Trim(Str(sy))
               
              End If
             
            End If '<== [CQ 11321]
           
            y = y + 1
           
            'Печатаем формулу на объем
            If PrmPrintFormulaInKoll Then y = Application.Run("SmetaUtils.xls!PrintSmetaKollByFormula", y, sy, xName)
           
            If Src.Cells(sy, 60).Value <> 3 Then PrintAddonSmStrBeforeSubStr y, sy '[CQ 11321]
           
         End If
                                           
         'Ценообразование
         If PrmPrintCompens Then
           y = Application.Run("SmetaUtils.xls!PrintCompens", y, sy, xNpp, xName)
         End If
         
         'Если строка последняя, то печатаем НР и СП с итогом по строчке
         aType = Application.Run("SmetaUtils.xls!SmStrNextType", sy, PrmPrintZeroStr, PrmIdLevelCost)
         If ((aType = 17) Or (aType = 0)) And (sySmStr > 0) Then
           PrintAddonSmStrAfterSubStr y, sySmStr, yStartSubStr
         End If
     
      End If 'End ZeroStr
     
    End If 'End Level
   
  End With
End Sub

Sub PrintAddonSmStrBeforeSubStr(ByRef y As Long, ByVal sy As Long)
Dim aIdLevel As Long

  With dst
 
    aIdLevel = Src.Cells(sy, 27).Value
    'Печатаем выбранный уровень
    'Строка исключенная из расчета на печать не попадает
    If PrmIdLevelCost = aIdLevel Then
   
      If (PrmPrintZeroInfo) Or (Src.Cells(sy, 19).Value <> 0) Then
       
         .Cells(y, xName) = "ЗП"
         
         'ОЗП баз.
         If (Not PrmPrintReplacePopr) And (Len(Trim(Src.Cells(sy, 111).Value)) > 0) And (Left(Trim(Src.Cells(sy, 111).Value), 1) = "=") Then
           .Cells(y, xEdCen).Formula = "=Source!AF" + Trim(Str(sy)) 'B - AO E - AF
         Else
           .Cells(y, xEdCen).Formula = "=Source!AO" + Trim(Str(sy)) 'B - AO E - AF
           .Cells(y, xPopr).Formula = "=Source!DG" + Trim(Str(sy)) 'B - AO E - AF
         End If
         
         .Cells(y, xZU).Formula = "=Source!AV" + Trim(Str(sy))
         
         'Стоимость ОЗП баз.
         If DocTwoLevel Then
           .Cells(y, xItogB).Formula = "=" & Application.Run("SmetaUtils.xls!ItogValueB", sy, OZP)
           .Cells(y, ColIt_FOT_B).Formula = "=" & Application.Run("SmetaUtils.xls!ItogValueB", sy, OZP)
         End If
                 
         'Индекс к ОЗП
         .Cells(y, xIndex).Formula = "=" & Application.Run("SmetaUtils.xls!IndexF", sy, OZP)
         
         'Стоимость ОЗП ит.
         .Cells(y, xItogC).Formula = "=Source!S" + Trim(Str(sy))
         
         FormatSmetaStr y
         y = y + 1
      End If
             
      If (PrmPrintZeroInfo) Or (Src.Cells(sy, 17).Value <> 0) Then
       
         .Cells(y, xName) = "ЭМ"
         
         'ЭММ баз.
         If (Not PrmPrintReplacePopr) And (Len(Trim(Src.Cells(sy, 109).Value)) > 0) And (Left(Trim(Src.Cells(sy, 109).Value), 1) = "=") Then
           .Cells(y, xEdCen).Formula = "=Source!AD" + Trim(Str(sy))
         Else
           .Cells(y, xEdCen).Formula = "=Source!AM" + Trim(Str(sy))
           .Cells(y, xPopr).Formula = "=Source!DE" + Trim(Str(sy))
         End If
       
         .Cells(y, xZU).Formula = "=Source!AV" + Trim(Str(sy))
         
         'Стоимость ЭММ баз.
         If DocTwoLevel Then
           .Cells(y, xItogB).Formula = "=" & Application.Run("SmetaUtils.xls!ItogValueB", sy, EMM)
         End If
                           
         'Индекс к ЭММ
         .Cells(y, xIndex).Formula = "=" & Application.Run("SmetaUtils.xls!IndexF", sy, EMM)
         
         'Стоимость ЭММ ит.
         .Cells(y, xItogC).Formula = "=Source!Q" + Trim(Str(sy))
         
          FormatSmetaStr y
          y = y + 1
      End If
             
      If (PrmPrintZeroInfo) Or (Src.Cells(sy, 18).Value <> 0) Then
     
         .Cells(y, xName) = "в т.ч. ЗПМ"
         
         'ЗПМ баз.
         If (Not PrmPrintReplacePopr) And (Len(Trim(Src.Cells(sy, 110).Value)) > 0) And (Left(Trim(Src.Cells(sy, 110).Value), 1) = "=") Then
           .Cells(y, xEdCen).Formula = "=Source!AE" + Trim(Str(sy))
         Else
           .Cells(y, xEdCen).Formula = "=Source!AN" + Trim(Str(sy)) 'B - AN E - AE
           .Cells(y, xPopr).Formula = "=Source!DF" + Trim(Str(sy)) 'B - AO E - AF
         End If
         
         .Cells(y, xZU).Formula = "=Source!AV" + Trim(Str(sy))
         
         'Стоимость ЗПМ баз.
         If DocTwoLevel Then
           .Cells(y, xItogB).Formula = "=" & Application.Run("SmetaUtils.xls!ItogValueB", sy, ZPM)
           .Cells(y, ColIt_FOT_B).Formula = .Cells(y, xItogB).Formula
         End If
         
         'Индекс к ЗПМ
         .Cells(y, xIndex).Formula = "=" & Application.Run("SmetaUtils.xls!IndexF", sy, ZPM)
         
         'Стоимость ЗПМ ит.
         .Cells(y, xItogC).Formula = "=Source!R" + Trim(Str(sy))
         
         FormatSmetaStr y
         If xItogB <> 0 Then .Cells(y, xItogB).Font.Italic = True
         .Cells(y, xItogC).Font.Italic = True
         y = y + 1
      End If
             
      If (PrmPrintZeroInfo) Or (Src.Cells(sy, 16).Value <> 0) Then

         .Cells(y, xName) = "МР"
         
         'Мат баз.
         If (Not PrmPrintReplacePopr) And (Len(Trim(Src.Cells(sy, 108).Value)) > 0) And (Left(Trim(Src.Cells(sy, 108).Value), 1) = "=") Then
           .Cells(y, xEdCen).Formula = "=Source!AC" + Trim(Str(sy))
         Else
           .Cells(y, xEdCen).Formula = "=Source!AL" + Trim(Str(sy)) 'B - AL E - AC
           .Cells(y, xPopr).Formula = "=Source!DD" + Trim(Str(sy)) 'B - AO E - AF
         End If
         
         .Cells(y, xZU).Formula = "=Source!AW" + Trim(Str(sy))
                       
         'Стоимость Мат баз.
         If DocTwoLevel Then
           .Cells(y, xItogB).Formula = "=" & Application.Run("SmetaUtils.xls!ItogValueB", sy, Mat)
         End If
         
         'Индекс к Мат
         .Cells(y, xIndex).Formula = "=" & Application.Run("SmetaUtils.xls!IndexF", sy, Mat)
                               
         'Стоимость Мат ит.
         .Cells(y, xItogC).Formula = "=Source!P" + Trim(Str(sy))
         
         FormatSmetaStr y
         y = y + 1
               
      End If 'End Level
   
    End If
   
  End With
End Sub

Sub PrintAddonSmStrAfterSubStr(ByRef y As Long, ByVal sy As Long, ByVal yStart As Long)
Dim aIdLevel As Long
Dim yEnd As Long

  With dst
 
    aIdLevel = Src.Cells(sy, 27).Value
    'Печатаем выбранный уровень
    'Строка исключенная из расчета на печать не попадает
    If PrmIdLevelCost = aIdLevel Then
     
      yEnd = y - 1
                     
      If (Src.Cells(sy, 60).Value <> 3) Then '[CQ 11321]
     
        If (PrmPrintZeroInfo) Or (Src.Cells(sy, 24).Value <> 0) Then
         
          'Если подчиненных строк нет...
          If yStart = 0 Then yStart = y
          yEnd = y
         
          FormatSmetaStr y
         
          .Cells(y, xName) = "НР от ЗП"
          .Cells(y, xEdIzm) = "%"
                 
          If DocTwoLevel Then
            '% НР базовый находиться в формуле ТР
            .Cells(y, xKoll).Formula = "=" & Application.Run("SmetaUtils.xls!NRSPValueB", sy, NR)
            'Получаем ВСЕГО в базисных ценах, руб.
            .Cells(y, xItogB).Formula = "=Sum(" & AbsoluteLink(yStartSmStr, ColIt_NR_B) & ":" & AbsoluteLink(y - 1, ColIt_NR_B) & ")"
            '% НР текущий находиться в индексах пересчета
            .Cells(y, xIndex).Formula = "=" & Application.Run("SmetaUtils.xls!NRSPValueB_Index", sy, NR)
          Else
            '% НР текущий находиться в индексах пересчета
            .Cells(y, xKoll).Formula = "=" & Application.Run("SmetaUtils.xls!NRSPValueB_Index", sy, NR)
          End If
         
          'Получаем ВСЕГО в текущих (прогнозных) ценах, руб.
          .Cells(y, xItogC).Formula = "=Sum(" & AbsoluteLink(yStartSmStr, ColIt_NR_C) & ":" & AbsoluteLink(y - 1, ColIt_NR_C) & ")"
         
          y = y + 1
        End If
       
        If (PrmPrintZeroInfo) Or (Src.Cells(sy, 25).Value <> 0) Then
         
          'Если подчиненных строк нет...
          If yStart = 0 Then yStart = y
          yEnd = y
         
          FormatSmetaStr y
         
          .Cells(y, xName) = "СП от ЗП"
          .Cells(y, xEdIzm) = "%"
                 
          If DocTwoLevel Then
            '% НР базовый находиться в формуле ТР
            .Cells(y, xKoll).Formula = "=" & Application.Run("SmetaUtils.xls!NRSPValueB", sy, SP)
            'Получаем ВСЕГО в базисных ценах, руб.
            .Cells(y, xItogB).Formula = "=Sum(" & AbsoluteLink(yStartSmStr, ColIt_SP_B) & ":" & AbsoluteLink(y - 1, ColIt_SP_B) & ")"
            '% НР текущий находиться в индексах пересчета
            .Cells(y, xIndex).Formula = "=" & Application.Run("SmetaUtils.xls!NRSPValueB_Index", sy, SP)
          Else
            '% НР текущий находиться в индексах пересчета
            .Cells(y, xKoll).Formula = "=" & Application.Run("SmetaUtils.xls!NRSPValueB_Index", sy, SP)
          End If
         
          'Получаем ВСЕГО в текущих (прогнозных) ценах, руб.
          .Cells(y, xItogC).Formula = "=Sum(" & AbsoluteLink(yStartSmStr, ColIt_SP_C) & ":" & AbsoluteLink(y - 1, ColIt_SP_C) & ")"
         
          y = y + 1
        End If
             
        If (PrmPrintZeroInfo) Or (Src.Cells(sy, 18).Value <> 0) Then
         
          'Если подчиненных строк нет...
          If yStart = 0 Then yStart = y
          yEnd = y
         
          FormatSmetaStr y
         
          .Cells(y, xName) = "НР и СП от ЗПМ"
          .Cells(y, xEdIzm) = "%"
                 
          If DocTwoLevel Then
            '% НР и СП от ЗПМ базовый
            .Cells(y, xKoll).Formula = "=" & Application.Run("SmetaUtils.xls!NRSPZPMValueB")
            'Получаем ВСЕГО в базисных ценах, руб.
            .Cells(y, xItogB).Formula = "=Sum(" & AbsoluteLink(yStartSmStr, ColIt_NR_SP_ZPM_B) & ":" & AbsoluteLink(y - 1, ColIt_NR_SP_ZPM_B) & ")"
            '% НР и СП от ЗПМ текущий
            .Cells(y, xIndex).Formula = "=" & Application.Run("SmetaUtils.xls!NRSPZPMValueC")
          Else
            '% НР и СП от ЗПМ текущий
            .Cells(y, xKoll).Formula = "=" & Application.Run("SmetaUtils.xls!NRSPZPMValueC")
          End If
         
          'Получаем ВСЕГО в текущих (прогнозных) ценах, руб.
          .Cells(y, xItogC).Formula = "=Sum(" & AbsoluteLink(yStartSmStr, ColIt_NR_SP_ZPM_C) & ":" & AbsoluteLink(y - 1, ColIt_NR_SP_ZPM_C) & ")"
           
          y = y + 1
        End If
                 
        If (PrmPrintZeroInfo) Or (Src.Cells(sy, 21).Value <> "0") Then
       
          .Cells(y, xName) = "ЗТР"
          .Cells(y, xEdIzm) = "чел-ч"
         
          If (Not PrmPrintReplacePopr) And (Len(Trim(Src.Cells(sy, 113).Value)) > 0) And (Left(Trim(Src.Cells(sy, 113).Value), 1) = "=") Then
            .Cells(y, xKoll).Formula = "=Source!AH" + Trim(Str(sy))
          Else
            .Cells(y, xKoll).Formula = "=Source!AQ" + Trim(Str(sy))
            .Cells(y, xPopr).Formula = "=Source!DI" + Trim(Str(sy))
          End If
          .Cells(y, xZU).Formula = "=Source!AV" + Trim(Str(sy))
         
          FormatSmetaStr y
         
          If DocTwoLevel Then
           .Cells(y, xItogB).Formula = "=Source!U" + Trim(Str(sy))
           .Cells(y, xItogB).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", 2)
          Else
           .Cells(y, xItogC + 1).Formula = "=Source!U" + Trim(Str(sy))
           .Cells(y, xItogC + 1).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", 2)
          End If
         
          y = y + 1
        End If
           
      End If
           
      PrintItogSmStr y, sy, yStart, yEnd
     
    End If 'End Level
   
  End With
End Sub

Function AbsoluteLink(ByVal aRow As Long, ByVal aCol As Long) As String
  With dst
    AbsoluteLink = .Cells(aRow, aCol).Address(RowAbsolute:=False, ColumnAbsolute:=False)
  End With
End Function

Sub PrintItogSmStr(ByRef y As Long, ByVal sy As Long, ByVal yStart As Long, ByVal yEnd As Long)
Dim aIdLevel As Long
Dim sCostB As String
Dim sSummB As String
Dim sSummC As String

  With dst
 
    aIdLevel = Src.Cells(sy, 27).Value
    'Печатаем выбранный уровень
    'Строка исключенная из расчета на печать не попадает
    If PrmIdLevelCost = aIdLevel Then
       
       'Текущий уровень
       If yStart > 0 Then
         sSummC = "+Sum(" & AbsoluteLink(yStart, xItogC) & ":" & AbsoluteLink(yEnd, xItogC) & ")"
       Else
         sSummC = ""
       End If
       .Cells(y, xItogC - 1).Formula = "=Source!O" & Trim(Str(sy)) & sSummC
       .Cells(y, ColIt_C).Formula = "=" & AbsoluteLink(y, xItogC - 1)
       FormatItogSmStr .Range(.Cells(y, xItogC - 1), .Cells(y, xItogC))
         
       If DocTwoLevel Then
         
         'Базовый уровень
         If yStart > 0 Then
           sSummB = "+Sum(" & AbsoluteLink(yStart, xItogB) & ":" & AbsoluteLink(yEnd, xItogB) & ")"
         Else
           sSummB = ""
         End If
         
         If EqualFrmItPZEdPZ(sy) Then
           sCostB = "=" & Application.Run("SmetaUtils.xls!ItogValueB", sy, PZ)
         Else
           sCostB = "=" & Application.Run("SmetaUtils.xls!ItogValueB", sy, Mat) & "+" & _
                          Application.Run("SmetaUtils.xls!ItogValueB", sy, OZP) & "+" & _
                          Application.Run("SmetaUtils.xls!ItogValueB", sy, EMM)
         End If
         .Cells(y, xItogB - 1).Formula = sCostB & sSummB
         
         .Cells(y, ColIt_B).Formula = "=" & AbsoluteLink(y, xItogB - 1)
         .Cells(y, ColIt_Stroit_B).Formula = "=IF(Source!BI" & Trim(Str(sy)) & "<=1," & AbsoluteLink(y, xItogB - 1) & ", 0)"
         .Cells(y, ColIt_Mont_B).Formula = "=IF(Source!BI" & Trim(Str(sy)) & "=2," & AbsoluteLink(y, xItogB - 1) & ", 0)"
         .Cells(y, ColIt_Oborud_B).Formula = "=IF(Source!BI" & Trim(Str(sy)) & "=3," & AbsoluteLink(y, xItogB - 1) & ", 0)"
         .Cells(y, ColIt_Other_B).Formula = "=IF(Source!BI" & Trim(Str(sy)) & "=4," & AbsoluteLink(y, xItogB - 1) & ", 0)"
       
         FormatItogSmStr .Range(.Cells(y, xItogB - 1), .Cells(y, xItogB))
       
       Else
                 
         'Усредненная стоимость
         .Cells(y, xItogC + 1).Formula = "=if(Source!I" & Trim(Str(sy)) & "<>0, ROUND(" & AbsoluteLink(y, xItogC - 1) & "/Source!I" & Trim(Str(sy)) & ", 2), 0)"
         FormatItogSmStr .Range(.Cells(y, xItogC + 1), .Cells(y, xItogC + 1))
       End If
       
       Underline .Range(.Cells(y - 1, 1), .Cells(y - 1, NmGraf))
       
       y = y + 1
     
    End If
   
  End With
 
End Sub

Sub FormatItogSmStr(ByVal Rng As Range)
 
  SetFont Rng, iSizeFont
 
  With Rng
    .HorizontalAlignment = xlHAlignRight
    .Merge
    .Font.Bold = True
    .NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", PercentIt)
  End With
 
End Sub

Sub PrintLimitir(ByRef y As Long, ByVal sy As Long)
Dim aType As Integer

  aType = GetTypeStructElem(sy)

  If PrmPrintLimItog And (aType > 1 Or (aType = 1 And PrmPrintItogObj)) Then '[CQ 11482]
   
    FormProgress.UpdateProgress sPLimItog & Src.Cells(sy, 7).Value, sy
   
    y = Application.Run("SmetaUtils.xls!PrintLimitir", y, sy, xName, xItogC, _
                        PrmSelectedLevelIndex, Not PrmPrintItog, xWrapLimTitle, xWrapLimNames, False)
                       
  End If
End Sub

Sub PrintFooters(ByRef y As Long)
Dim aSheetName As String
Dim aRangeFooter As String
 
  If PrmPrintFooter Then
   
    y = y + 2
     
    InitRangeInSheet aSheetName
    InitRangeFooter aRangeFooter
     
    Set TmpSheet = ThisWorkbook.Sheets(aSheetName)
    TmpSheet.Activate
    TmpSheet.Range(aRangeFooter).Select
    TmpSheet.Range(aRangeFooter).Copy
     
    With dst
   
      .Activate
      .Cells(y, 1).PasteSpecial
      .Cells(1, 1).Select
     
      PrintOneFooter y
         
    End With
 
  End If
 
End Sub

Sub PrintOneFooter(ByRef y As Long)
Dim sy As Long

  With dst
 
    If UseAkt Then sy = 15 Else sy = 12
   
    'Смета по МТСН
    If (DocType = 0) Then
       
       'Составил Должность
       .Cells(y, xName).Formula = "=IF(Source!AC" & Trim(Str(sy)) & "<>"""", Source!AC" & Trim(Str(sy)) & ","" "")"
       
       'Проверил Должность
       .Cells(y + 3, xName).Formula = "=IF(Source!AE" & Trim(Str(sy)) & "<>"""", Source!AE" & Trim(Str(sy)) & ","" "")"
       
       'Составил ФИО
       .Cells(y, 8).Formula = "=IF(Source!AB" & Trim(Str(sy)) & "<>"""", Source!AB" & Trim(Str(sy)) & ","" "")"
       
       'Проверил ФИО
       .Cells(y + 3, 8).Formula = "=IF(Source!AD" & Trim(Str(sy)) & "<>"""", Source!AD" & Trim(Str(sy)) & ","" "")"
       
       y = y + 5
       
    'Акт по МТСН
    'Акт КС-2 по МТСН
    ElseIf (DocType = 1) Or (DocType = 2) Then
       
       '==> [CQ 11254]
       If UseAkt Then
       
         'Сдал Должность
         .Cells(y, xName).Formula = "=IF(Source!AC" & Trim(Str(sy)) & "<>"""", Source!AC" & Trim(Str(sy)) & ","" "")"
         
         'Принял Должность
         .Cells(y + 3, xName).Formula = "=IF(Source!AG" & Trim(Str(sy)) & "<>"""", Source!AG" & Trim(Str(sy)) & ","" "")"
         
         'Сдал ФИО
         .Cells(y, NmGraf - 3).Formula = "=IF(Source!AB" & Trim(Str(sy)) & "<>"""", Source!AB" & Trim(Str(sy)) & ","" "")"
         
         'Принял ФИО
         .Cells(y + 3, NmGraf - 3).Formula = "=IF(Source!AF" & Trim(Str(sy)) & "<>"""", Source!AF" & Trim(Str(sy)) & ","" "")"
         
       Else
       
         'Сдал Должность
         .Cells(y, xName).Formula = "=IF(Source!AM" & Trim(Str(sy)) & "<>"""", Source!AM" & Trim(Str(sy)) & ","" "")"
         
         'Принял Должность
         .Cells(y + 3, xName).Formula = "=IF(Source!AI" & Trim(Str(sy)) & "<>"""", Source!AI" & Trim(Str(sy)) & ","" "")"
         
         'Сдал ФИО
         .Cells(y, NmGraf - 3).Formula = "=IF(Source!AL" & Trim(Str(sy)) & "<>"""", Source!AL" & Trim(Str(sy)) & ","" "")"
         
         'Принял ФИО
         .Cells(y + 3, NmGraf - 3).Formula = "=IF(Source!AH" & Trim(Str(sy)) & "<>"""", Source!AH" & Trim(Str(sy)) & ","" "")"

       End If
       '<== [CQ 11254]
         
       y = y + 6
   
    End If
   
  End With
   
End Sub

Sub PrintLocalHeaders(ByRef y As Long, ByVal sy As Long)
Dim aSheetName As String
Dim aRangeHeader As String

  FormProgress.UpdateProgress sPHeaderDoc, sy
 
  If PrmPrintTitle Then        ' Печатать титул
    PrintMainHeader y 'Печать титула
  End If
   
  PrintHeaderUtv y, sy
   
  InitRangeInSheet aSheetName
  InitRangeHeader aRangeHeader
   
  Set TmpSheet = ThisWorkbook.Sheets(aSheetName)
  TmpSheet.Activate
  TmpSheet.Range(aRangeHeader).Select
  TmpSheet.Range(aRangeHeader).Copy
   
  With dst
 
    .Activate
    .Cells(y, 1).PasteSpecial
    .Cells(1, 1).Select
   
    PrintOneLocalHeader y, sy
   
    yLS = y
    NumPP = 0
   
    header_cnt = header_cnt + 1
    If header_cnt = 1 Then
     With .PageSetup
        .PrintTitleRows = "$" + Trim(Str(y - 1)) + ":$" + Trim(Str(y - 1))
        .PrintTitleColumns = ""
     End With
    End If
   
  End With
 
End Sub

Sub PrintHeaderUtv(ByRef y As Long, ByVal sy As Long)
Dim Ly As Long
Dim aSheetName As String
Dim aRangeHeaderUtv As String
   
  If PrmHeaderUtv Then
    InitRangeInSheet aSheetName
    InitRangeHeaderUtv aRangeHeaderUtv
   
    Set TmpSheet = ThisWorkbook.Sheets(aSheetName)
    TmpSheet.Activate
    TmpSheet.Range(aRangeHeaderUtv).Select
    TmpSheet.Range(aRangeHeaderUtv).Copy
     
    With dst
   
      If UseAkt Then Ly = 15 Else Ly = 12
   
      .Activate
      .Cells(y, 1).PasteSpecial
      .Cells(1, 1).Select
     
      If PrmHeaderUtv Then
        If DocTwoLevel Then
          .Cells(y, 11) = "Форма № 1б"
        Else
          .Cells(y, 11) = "Форма № 1а"
        End If
      End If
     
      'ГенПодр Орг
       Application.Run ("SmetaUtils.xls!PrintUTVHeaderPodr"), y + 2, 2, Ly
      'ГенПодр ФИО
      .Cells(y + 4, 2).Formula = "=CONCATENATE(""______________________ "", IF(Source!AL" & Trim(Str(Ly)) & "<>"""", Source!AL" & Trim(Str(Ly)) & ", """"))"
      'Год
      .Cells(y + 5, 2).Value = """_____""________________ " & Year(Now) & " г."

      'Заказчик Орг
      Application.Run ("SmetaUtils.xls!PrintUTVHeaderZakaz"), y + 2, 7, Ly
      'Заказчик ФИО
      .Cells(y + 4, 7).Formula = "=CONCATENATE(""______________________ "", IF(Source!AH" & Trim(Str(Ly)) & "<>"""", Source!AH" & Trim(Str(Ly)) & ", """"))"
      'Год
      .Cells(y + 5, 7).Value = """_____""________________ " & Year(Now) & " г."
     
      y = y + 7
    End With
  End If
 
End Sub

Sub PrintMainHeader(ByRef y As Long)
  With dst
     .Cells(y, 1).Formula = "=CONCATENATE(Source!B1, ""     ТСН-2001 (© ОАО МЦЦС 'Мосстройцены', 2006)"")"
     SetFont .Cells(y, 1), iSizeFont - 2
     y = y + 1
  End With
End Sub

Sub PrintOneLocalHeader(ByRef y As Long, ByVal sy As Long)
Dim Ly As Long
Dim aTypeTitle As Integer
 
  With dst
 
    aTypeTitle = 2
    If UseAkt Then Ly = 15 Else Ly = 12
   
    'Смета по МТСН
    If (DocType = 0) Then
       
       If Not PrmHeaderUtv Then
         If DocTwoLevel Then
           .Cells(y, 11) = "Форма № 1б"
         Else
           .Cells(y, 11) = "Форма № 1а"
         End If
       End If
       
       'Стройка
       '==> [CQ 11135]
       If Src.Cells(4, 7).Value <> "" Then
         Application.Run ("SmetaUtils.xls!PrintStroyka"), y + 1, 1
         WrapLongName xWrapStruct, y + 1
       End If
       
       'Шифр структуры
'       .Cells(y + 4, 1).Formula = "=CONCATENATE( ""ЛОКАЛЬНАЯ СМЕТА № "" , Source!F" + Trim(Str(sy)) + ")"
       '==> [CQ 11482]
       If PrmHeaderOnLs Then
         .Cells(y + 4, 1).Formula = "=CONCATENATE( ""ЛОКАЛЬНАЯ СМЕТА № "" ,IF(Source!F" & Trim(Str(sy)) & "<>""Новая локальная смета"", Source!F" & Trim(Str(sy)) & ", """"))"
       Else
         .Cells(y + 4, 1).Formula = "=CONCATENATE( ""ЛОКАЛЬНАЯ СМЕТА № "" ,IF(Source!F12" & "<>""Новый объект"", Source!F12" & ", """"))"
       End If
       WrapLongName xWrapStruct, y + 4
       
       'Наименование структуры
       '==> [CQ 11135]
       If PrmHeaderOnLs Then
         .Cells(y + 7, 1).Formula = "=IF(Source!G" & Trim(Str(sy)) & "<>""Новая локальная смета"", Source!G" & Trim(Str(sy)) & ", """")"  '[CQ 11482]
         WrapLongName xWrapStruct, y + 7
       End If
       
       If Not PrmHeaderOnLs Or .Cells(y + 7, 1).Value = "" Then  '[CQ 11482]
         .Rows(y + 7).Hidden = True
         .Rows(y + 8).Hidden = True
       End If
             
'       '==> [CQ 11278]
'       If PrmHeaderOnLs Then
'         'Наименование сметы, Наименование Объекта
'         .Cells(y + 9, 1).Formula = "=CONCATENATE(CONCATENATE(Source!G" & Trim(Str(sy)) & ", "", ""), IF(Source!G12<>"""",Source!G12,Source!F12))"
'       Else
         'Наименование Объекта
         '.Cells(y + 9, 1).Formula = "=Source!G12"
         .Cells(y + 9, 1).Formula = "=IF(Source!G12" & "<>""Новый объект"", Source!G12" & ", """")"  '[CQ 11482]
'       End If
       WrapLongName xWrapStruct, y + 9
       
       'Чертежи структуры
       .Cells(y + 12, 1).Formula = "=CONCATENATE( ""Основание: чертежи № "" , Source!J" & Trim(Str(sy)) + ")"
       WrapLongName xWrapStruct, y + 12
             
       y_header = y + 14
       
       'Составлена в ценах
       Application.Run ("SmetaUtils.xls!PrintTitleCost"), y + 20, 1, aTypeTitle, PrmSelectedLevelIndex
       
       .Rows(y_header + 1).Hidden = Not PrmPrintItogVidRab
       .Rows(y_header + 2).Hidden = Not PrmPrintItogVidRab
       .Rows(y_header + 3).Hidden = Not PrmPrintItogVidRab
       .Rows(y_header + 4).Hidden = Not PrmPrintItogVidRab
       
       If DocTwoLevel Then
         y = y + 23
       Else
         y = y + 25
       End If
   
    'Акт по МТСН
    ElseIf (DocType = 1) Then
   
       'Заказчик орг
       .Cells(y + 1, 3).Formula = "=IF(Source!AJ" & Trim(Str(Ly)) & "<>"""", Source!AJ" & Trim(Str(Ly)) & ","" "")"
       
       'Подрядчик орг
       .Cells(y + 3, 3).Formula = "=IF(Source!AN" & Trim(Str(Ly)) & "<>"""", Source!AN" & Trim(Str(Ly)) & ","" "")"
   
       'Шифр Объекта
       '.Cells(y + 8, 3).Formula = "=Source!F12"
       .Cells(y + 8, 3).Formula = "=IF(Source!F12" + "<>""Новый объект"", Source!F12" + ", """")"  '[CQ 11482]
       WrapLongName xWrapHeader, y + 8
       
       'Наименование структуры
       '==> [CQ 11482]
       If Src.Cells(sy, 7).Value <> "Новая локальная смета" And Src.Cells(sy, 7).Value <> "Новый объект" Then  '[CQ 11482]
         .Cells(y + 10, 3).Formula = "=Source!G" & Trim(Str(sy))
         WrapLongName xWrapHeader, y + 10
       End If
       
'       '==> [CQ 11278]
'       If PrmHeaderOnLs Then
'         'Наименование сметы, Наименование Объекта
'         .Cells(y + 10, 3).Formula = "=CONCATENATE(CONCATENATE(Source!G" & Trim(Str(sy)) & ", "", ""), IF(Source!G12<>"""",Source!G12,Source!F12))"
'       Else
'         'Наименование Объекта
'         .Cells(y + 10, 3).Formula = "=Source!G12"
'       End If
'       WrapLongName xWrapHeader, y + 10
'       '<== [CQ 11278]
       
       'Составлена в ценах
       Application.Run ("SmetaUtils.xls!PrintTitleCost"), y + 13, 1, aTypeTitle, PrmSelectedLevelIndex
       
       If DocTwoLevel Then
        .Rows(y + 16).RowHeight = 20
        .Rows(y + 17).RowHeight = 20
         y = y + 19
       Else
         y = y + 18
       End If
       
    'Акт КС-2 по МТСН
    ElseIf (DocType = 2) Then
   
       'Инвестор орг
       Application.Run ("SmetaUtils.xls!PrintInvestorOrgInfo"), y + 7, 3
       WrapLongName xWrapHeader, y + 7
       'Инвестор ОКПО
       .Cells(y + 7 - 1, NmGraf - 2).Formula = "=IF(Source!AT15 <> """", Source!AT15, """")"
   
       'Заказчик орг
       Application.Run ("SmetaUtils.xls!PrintZakazOrgInfo"), y + 9, 3, Ly
       WrapLongName xWrapHeader, y + 9
       'Заказчик ОКПО
       .Cells(y + 9 - 1, NmGraf - 2).Formula = "=IF(Source!AK15 <> """", Source!AK15, """")"
       
       'Подрядчик орг
       Application.Run ("SmetaUtils.xls!PrintPodrOrgInfo"), y + 11, 3, Ly
       WrapLongName xWrapHeader, y + 11
       'Подрядчик ОКПО
       .Cells(y + 11 - 1, NmGraf - 2).Formula = "=IF(Source!AO15 <> """", Source!AO15, """")"
       
       'Стройка
       Application.Run ("SmetaUtils.xls!PrintStroykaInfo"), y + 13, 3
       WrapLongName xWrapHeader, y + 13
       'Стройка ОКПО
       .Cells(y + 13 - 1, NmGraf - 2).Formula = "=IF(Source!CO15 <> """", Source!CO15, """")"
       WrapLongName xWrapHeader, y + 13
       
       'Объект
       '==> [CQ 11482]
       .Cells(y + 15, 3).Formula = "=IF(Source!G12" + "<>""Новый объект"", Source!G12" + ", """")"  '[CQ 11482]
       WrapLongName xWrapHeader, y + 15
       'Объекта ОКПО
       .Cells(y + 15 - 1, NmGraf - 2).Formula = "=IF(Source!CP15 <> """", Source!CP15, """")"
       
       'Вид деятельности по ОКДП
       .Cells(y + 17, NmGraf - 2).Formula = "=IF(Source!CQ15 <> """", Source!CQ15, """")"
       
       'номер договора подряда
       .Cells(y + 18, NmGraf - 2).Formula = "=IF(Source!CR15 <> """", Source!CR15, """")"
       
       'дата договора подряда
       .Cells(y + 19, NmGraf - 2).Formula = "=IF(Source!CS15 <> 0, Source!CS15, """")"
       
       'вид операции
       .Cells(y + 20, NmGraf - 2).Formula = "=IF(Source!CT15 <> """", Source!CT15, """")"
       
       'Номер документа
       .Cells(y + 24, 7).Formula = "=IF(Source!CN15 <> """", Source!CN15, """")"
       
       'Дата составления
       .Cells(y + 24, 8).Value = Now
       
       'Сметная стоимость
       Application.Run ("SmetaUtils.xls!PrintSmCost"), y + 29, NmGraf - 4, sy, PrmSelectedLevelIndex
       
       'Составлена в ценах
       Application.Run ("SmetaUtils.xls!PrintTitleCost"), y + 30, 1, aTypeTitle, PrmSelectedLevelIndex
       
       If DocTwoLevel Then
        .Rows(y + 34).RowHeight = 20
        .Rows(y + 35).RowHeight = 20
       
         y = y + 37
       Else
         y = y + 35
       End If
   
    End If
   
  End With
 
End Sub

Sub PrintStructure(ByRef y As Long, ByVal sy As Long)
Dim aType As Integer
                         
  With dst
                         
    y = y + 1 'CQ[10895]
   
    aType = Src.Cells(sy, 1).Value
    If aType = 3 Then
      yLS = y
    ElseIf aType = "4" Then
      yRazd = y
    ElseIf aType = "5" Then
      yPodRazd = y
    End If
   
    SetCaptionStructElem y, sy, aType, 1
   
    FormatStructStr y
       
    y = y + 1

  End With

End Sub

Function GetTypeStructElem(ByVal sy As Long) As Integer
 
  If (Src.Cells(sy, 1).Value = "51") Then
    GetTypeStructElem = Src.Cells(sy, 3).Value
  Else
    GetTypeStructElem = 1
  End If
 
End Function

Function GetStructElem(ByVal sy As Long) As Long
Dim aType As Integer
   
  aType = GetTypeStructElem(sy)
 
  If (aType = 1) Then
    GetStructElem = 1
  ElseIf (aType = 3) Then
    GetStructElem = yLS
  ElseIf (aType = 4) Then
    GetStructElem = yRazd
  ElseIf (aType = 5) Then
    GetStructElem = yPodRazd
  End If
 
End Function

Sub PrintItogStruct(ByRef y As Long, ByVal sy As Long, ByVal yStart As Long)
Dim aType As Integer

  With dst
 
    aType = GetTypeStructElem(sy)
   
    If PrmPrintItog And (aType > 1 Or (aType = 1 And PrmPrintItogObj)) Then '[CQ 11482]

      y = y + 1
       
      SetCaptionStructElem y, sy, GetTypeStructElem(sy), 2

      .Cells(y, xItogC - 1).Formula = "=Sum(" & AbsoluteLink(yStart, ColIt_C) & ":" & AbsoluteLink(y - 1, ColIt_C) & ")"
      If DocTwoLevel Then
        .Cells(y, xItogB).Formula = "=Sum(" & AbsoluteLink(yStart, ColIt_B) & ":" & AbsoluteLink(y - 1, ColIt_B) & ")"
      End If
     
      FormatItog y
           
      y = y + 2
    End If
   
    SetHeaderItog sy, yStart, y - 1
   
  End With
 
End Sub

Sub SetCaptionStructElem(ByVal y As Long, ByVal sy As Long, ByVal aStuctType As Long, ByVal aCaptionType As Long)
Dim sName As String

  'aCaptionType = 1 Наименование элемента структуры
  'aCaptionType = 2 Наименование итога
 
  With dst
   
    If aStuctType = 1 Then
      If aCaptionType = 2 Then
        If UseAkt Then
          sName = "акту: "
        Else
          sName = "смете: "
        End If
      End If
    ElseIf aStuctType = 3 Then
      If aCaptionType = 1 Then
        sName = "Локальная смета: "
      ElseIf aCaptionType = 2 Then
        sName = "локальной смете: "
      End If
    ElseIf aStuctType = 4 Then
      If aCaptionType = 1 Then
        sName = "Раздел: "
      ElseIf aCaptionType = 2 Then
        sName = "разделу: "
      End If
    ElseIf aStuctType = 5 Then
      If aCaptionType = 1 Then
        sName = "Подраздел: "
      ElseIf aCaptionType = 2 Then
        sName = "подразделу: "
      End If
    End If
   
    If aCaptionType = 1 Then
      sName = sName
    ElseIf aCaptionType = 2 Then
      sName = "Итого по " & sName
    End If
   
    '.Cells(y, 1).Formula = "=CONCATENATE(""" & sName & """, Source!G" + Trim(Str(sy)) + ")"
    '==> [CQ 11482]
    If aStuctType = 1 Then
      .Cells(y, 1).Formula = "=CONCATENATE(""" & sName & """,IF(Source!G" + Trim(Str(sy)) + "<>""Новый объект"", Source!G" + Trim(Str(sy)) + ", """"))"
    ElseIf aStuctType = 3 Then
      .Cells(y, 1).Formula = "=CONCATENATE(""" & sName & """,IF(Source!G" + Trim(Str(sy)) + "<>""Новая локальная смета"", Source!G" + Trim(Str(sy)) + ", """"))"
    ElseIf aStuctType = 4 Then
      .Cells(y, 1).Formula = "=CONCATENATE(""" & sName & """,IF(Source!G" + Trim(Str(sy)) + "<>""Новый раздел"", Source!G" + Trim(Str(sy)) + ", """"))"
    ElseIf aStuctType = 5 Then
      .Cells(y, 1).Formula = "=CONCATENATE(""" & sName & """,IF(Source!G" + Trim(Str(sy)) + "<>""Новый подраздел"", Source!G" + Trim(Str(sy)) + ", """"))"
    End If
   
  End With
 
End Sub

Sub SetHeaderItog(ByVal sy As Integer, ByVal yStart As Long, ByVal yEnd As Long)
Dim aType As Integer
 
  With dst
   
    aType = GetTypeStructElem(sy)
   
    If ((aType = 1) And Not PrmHeaderOnLs) Or ((aType = 3) And PrmHeaderOnLs) Then
     
      'Смета МТСН
      If (DocType = 0) Then
     
        If DocTwoLevel Then
           
            'Сметная стоимость
            .Cells(y_header + 0, xItogB).Formula = "=Sum(" & AbsoluteLink(yStart, ColIt_B) & ":" & AbsoluteLink(yEnd, ColIt_B) & ")/1000"
            .Cells(y_header + 0, xItogB).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", 2)
           
            'Строительные работы
            .Cells(y_header + 1, xItogB).Formula = "=Sum(" & AbsoluteLink(yStart, ColIt_Stroit_B) & ":" & AbsoluteLink(yEnd, ColIt_Stroit_B) & ")/1000"
            .Cells(y_header + 1, xItogB).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", 2)
           
            'Монтажные работы
            .Cells(y_header + 2, xItogB).Formula = "=Sum(" & AbsoluteLink(yStart, ColIt_Mont_B) & ":" & AbsoluteLink(yEnd, ColIt_Mont_B) & ")/1000"
            .Cells(y_header + 2, xItogB).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", 2)
           
            'Оборудование
            .Cells(y_header + 3, xItogB).Formula = "=Sum(" & AbsoluteLink(yStart, ColIt_Oborud_B) & ":" & AbsoluteLink(yEnd, ColIt_Oborud_B) & ")/1000"
            .Cells(y_header + 3, xItogB).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", 2)
             
            'Прочие работы
            .Cells(y_header + 4, xItogB).Formula = "=Sum(" & AbsoluteLink(yStart, ColIt_Other_B) & ":" & AbsoluteLink(yEnd, ColIt_Other_B) & ")/1000"
            .Cells(y_header + 4, xItogB).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", 2)
           
            'Средства на оплату труда
            .Cells(y_header + 5, xItogB).Formula = "=Sum(" & AbsoluteLink(yStart, ColIt_FOT_B) & ":" & AbsoluteLink(yEnd, ColIt_FOT_B) & ")/1000"
            .Cells(y_header + 5, xItogB).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", 2)
           
        End If
       
        'Сметная стоимость текущий
        Application.Run ("SmetaUtils.xls!PrintSmCost"), y_header + 0, xItogC - 1, sy, PrmSelectedLevelIndex
        'Строительные работы текущий
        Application.Run ("SmetaUtils.xls!PrintStroitCost"), y_header + 1, xItogC - 1, sy, PrmSelectedLevelIndex
        'Монтажные работы текущий
        Application.Run ("SmetaUtils.xls!PrintMontCost"), y_header + 2, xItogC - 1, sy, PrmSelectedLevelIndex
        'Оборудование текущий
        Application.Run ("SmetaUtils.xls!PrintOborudCost"), y_header + 3, xItogC - 1, sy, PrmSelectedLevelIndex
        'Прочие работы
        Application.Run ("SmetaUtils.xls!PrintOtherCost"), y_header + 4, xItogC - 1, sy, PrmSelectedLevelIndex
        'Средства на оплату труда текущий
        Application.Run ("SmetaUtils.xls!PrintCompensationTrud"), y_header + 5, xItogC - 1, sy, PrmSelectedLevelIndex
       
      End If
     
    End If

  End With
 
End Sub

Sub FormatItog(ByVal y As Long)
Dim x_TitleEnd As Integer

  With dst
 
    SetFont .Range(.Cells(y, 1), .Cells(y, NmGraf)), iSizeFont
    .Range(.Cells(y, 1), .Cells(y, NmGraf)).Font.Bold = True
   
    With .Range(.Cells(y, xItogC - 1), .Cells(y, xItogC))
      .HorizontalAlignment = xlRight
      .Merge
    End With
    .Cells(y, xItogC - 1).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", PercentIt)
       
    If DocTwoLevel Then
      With .Range(.Cells(y, xItogB - 1), .Cells(y, xItogB))
        .HorizontalAlignment = xlRight
        .Merge
      End With
      .Cells(y, xItogB - 1).NumberFormat = Application.Run("SmetaUtils.xls!CaseFormatByRound", PercentIt)
           
      x_TitleEnd = xItogB - 2
    Else
      x_TitleEnd = xItogC - 2
    End If
   
    .Range(.Cells(y, 1), .Cells(y, x_TitleEnd)).Merge
    .Cells(y, 1).WrapText = True
    .Cells(y, 1).HorizontalAlignment = xlLeft
    WrapLongName xWrapItogName, y
   
  End With

End Sub

Sub Underline(ByVal Rng As Range)
  With Rng.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
  End With
End Sub

Sub SetFont(ByVal Rng As Range, ByVal aSize As Integer)
  With Rng.Font
    .Name = sFontName
    .Size = aSize
  End With
End Sub

'Инициализация РР
Sub InitRR()
  Dim RRxTab As Integer
  Dim RRxName As Integer
  Dim RRxNameEnd As Integer
  Dim RRxEdIzm As Integer
  Dim RRxKol As Integer
  Dim RRxCena As Integer
  Dim RRxStoim As Integer
  Dim RRxStart As Integer
  Dim RRxLast As Integer
 
  If Not PrmPrintRR Then Exit Sub
 
  RRxTab = xTab
  RRxName = xName
  RRxNameEnd = xName + 3
  RRxEdIzm = xName + 4
  RRxKol = xName + 5
  RRxCena = xName + 6
  RRxStoim = xName + 7
  RRxStart = RRxTab
  RRxLast = RRxStoim

  Application.Run ("SmetaUtils.xls!InitResVed"), _
                   PrmPrintRRTrud, _
                   PrmPrintRRMash, _
                   PrmPrintRRMat, _
                   PrmPrintRRPriceInfo, _
                   PrmPrintRRZeroStr, _
                   PrmPrintRRNegativeValue, _
                   RRxTab, _
                   RRxName, _
                   RRxNameEnd, _
                   RRxEdIzm, _
                   RRxKol, _
                   RRxCena, _
                   RRxStoim, _
                   RRxStart, _
                   RRxLast, _
                   xWrapRRTitle, _
                   xWrapRRName
End Sub

Sub PrintRV(ByRef y As Long, ByVal sy As Long)
Dim syStart As Long
 
  If PrmPrintRR Then
   
    If (Src.Cells(sy, 3).Value = 1) Or PrmPrintRRInStruct Then
 
      FormProgress.UpdateProgress sPResVed & Src.Cells(sy, 7).Value, sy
   
      syStart = Src.Cells(sy, 4).Value
     
      y = Application.Run("SmetaUtils.xls!PrintRR", y, syStart, sy, PrmIdLevelCost)
   
    End If
   
  End If
 
End Sub

Function OpenSmetaUtils() As Boolean
Dim aCurrBook As Workbook

  On Error GoTo aErrorOpening
 
    Set aCurrBook = ActiveWorkbook
 
    Application.Workbooks.Open (ThisWorkbook.Path & "\" & SmetaUtilsBook)
    Set WBSmetaUtils = Workbooks(SmetaUtilsBook)
   
    OpenSmetaUtils = True
    aCurrBook.Activate
   
    Application.Run ("SmetaUtils.xls!InitSmetaUtils"), _
                     Nothing, _
                     ActiveWorkbook.Sheets("Source"), _
                     ActiveWorkbook.Sheets("SmtRes"), _
                     ActiveWorkbook.Sheets("EtalonRes"), _
                     iSizeFont, _
                     sFontName
Exit Function

aErrorOpening:
  MsgBox "Не могу сформировать документ. Не удалось открыть утилиту: " & ThisWorkbook.Path & "\" & SmetaUtilsBook
  OpenSmetaUtils = False
End Function

Function CloseSmetaUtils() As Boolean
 
  On Error GoTo aErrorClose
 
    WBSmetaUtils.Close False
   
    CloseSmetaUtils = True
Exit Function

aErrorClose:
  CloseSmetaUtils = False
End Function

Sub WrapLongName(ByVal xWrap As Integer, ByVal y As Long)
Dim xStart As Integer
Dim xEnd As Integer
Dim I As Integer
Dim aLen As Double
 
  If xWrap = xWrapHeader Then
    xStart = 3
   
    If (DocType = 1) Then     'Акт по МТСН
      xEnd = NmGraf
    ElseIf (DocType = 2) Then 'Акт KC-2 по МТСН
      xEnd = NmGraf - 4
    End If
   
  ElseIf xWrap = xWrapStruct Then
    xStart = 1
    xEnd = NmGraf
   
  ElseIf xWrap = xWrapItogName Then
    xStart = 1
    If DocTwoLevel Then
      xEnd = xItogB - 2
    Else
      xEnd = xItogC - 2
    End If
   
  End If
 
  With dst
 
    aLen = 3
    For I = xStart To xEnd
      aLen = aLen + .Columns(I).ColumnWidth
    Next I
   
    .Columns(xWrap).ColumnWidth = aLen
    .Cells(y, xStart).Copy Destination:=.Cells(y, xWrap)
    .Cells(y, xWrap).Formula = .Cells(y, xStart).Formula
  End With
 
End Sub

Если вас не затруднит, выделите, пожалуйста, жирным шрифтом, где этот текст: " Smeta.RU (495) 974-1589 ТСН-2001 (© ОАО МЦЦС 'Мосстройцены', 2006)"

[Timur]

Если вас не затруднит, выделите, пожалуйста, жирным шрифтом

всю ночь искал и нашел это Sub PrintMainHeader(ByRef y As Long)

по частям поищите...может получиться...

Уж не знаю почему у вас не получилось найти. )))

[grandtex]

В 7 версии дефектная ведомость ТСН выходила с обозначенными границами ячеек, хотелось бы вернуть этот макрос и в 8 ю версию.

[Timur]

В 7 версии дефектная ведомость ТСН выходила с обозначенными границами ячеек, хотелось бы вернуть этот макрос и в 8 ю версию.

Хотелось бы более подробнее понять о чем идет речь?

Если речь идет об этом, то посмотрим!
P.S. Не надо плодить одинаковые сообщения по разным темам. ))

[grandtex]

В 7 версии дефектная ведомость ТСН выходила с обозначенными границами ячеек, хотелось бы вернуть этот макрос и в 8 ю версию.

Хотелось бы более подробнее понять о чем идет речь?

Если речь идет об этом, то посмотрим!
P.S. Не надо плодить одинаковые сообщения по разным темам. ))

Да, именно об этом. Извините за повторение.

[arbeiten]

Как отредатировать шаблон, чтобы расчет объема выделялся жирным шрифтом?

[expert69]

Как отредатировать шаблон, чтобы расчет объема выделялся жирным шрифтом?

Меня иногда удивляет, зачем Вам столько всякой мелочевки? )))

[arbeiten]

expert69

это не "мелочевка". Так будет виднее при проверке.

Если "не секрет фирмы", буду премного благодарен за ответ :

Как отредатировать шаблон, чтобы расчет объема выделялся жирным шрифтом

[arbeiten]

forum4/topic30450-30.html#p103534

Как отредатировать шаблон, чтобы расчет объема выделялся жирным шрифтом?

Все еще актуально Мне прислали кусок макроса в личку, как его отредактировать не разобрался )



Еще вопрос: в выходной форме в экселе не печатается формула расчета объема (в программе стоит формула, в выходном файле просто значение) . Куда копать?

[Timur]

Еще вопрос: в выходной форме в экселе не печатается формула расчета объема (в программе стоит формула, в выходном файле просто значение) . Куда копать?

Вы просите не первый. Уже занесенно в план работ.

[arbeiten]

Добавьте форму вывода материалов из сметы в том же порядке в котором материалы идут в смете.
Заранее спасибо!

[Timur]

Добавьте форму вывода материалов из сметы в том же порядке в котором материалы идут в смете.

в 8.0.0.30 появилась форма "Расчет стоимости ресурсов". Она вас не устраивает?