Attribute VB_Name = "Module1"
Option Private Module
Option Explicit
Public repPath As String, repName As String, Er As Integer, lnLastRowsCount As Long, _
       dbPath As String, dbSelect As String, dbSelectGroup As String, lcAddParam As String, lcAddModule As String, _
       wsd As Object, wso As Object, wsr As Object, wsh As Object, _
       rCurRow As Range, rStartRow As Range, rEndRow As Range, rGroupOrderRange As Range, rCurentRange As Range, _
       lnBits As Byte, SheetFieldName As String, lcAddModuleFunc As String, lcAddModuleFuncArg As String, _
       rStartGroup As Range, rEndGroup As Range, _
       columnsCount As Integer, rowsCount As Long, groupCount As Integer, _
       curPosD As Long, curPosR As Long, curGroup As Integer, _
       gStartPosD(101) As Long, gEndPosD(101) As Long, _
       gStartPosH(101) As Long, gEndPosH(101) As Long, _
       gStartPosF(101) As Long, gEndPosF(101) As Long, _
       gStartPosDet As Long, gEndPosDet As Long, _
       gVal(101), lnOldDisplayZeros As Boolean, _
       nxlFreezePanes As Boolean, nxlPages As Boolean, nxlDateTime As Boolean, _
       nxlLeftHeader As String, nxlCenterHeader As String, nxlRightHeader As String, _
       DataStartRow As Long, GroupStartRow As Long, _
       lcWsoName As String, _
       lcAddModuleFunc2 As String, lcAddModuleFuncArg2 As String, lbStat As Boolean, _
       dTime1 As Date, dTime2 As Date, nTimeDiff As Integer, dTimeBegin As Date, dTimePage As Date, dTimeAllPage As Date, _
       lcLogFile As String, lnLogMode As Integer, SheetFieldColumn As Integer, _
       cAutoSaveName As String, cAutoSavePath As String, _
       lcTableFile As String, _
       wsoRange As Range, _
       lcSheetOptions As String, lcStyleOptions As String, lnSheetsCount As Integer, lnSheet As Integer, _
       groupProp(101, 15) '0-поле, 1-столбец, 2-нов.лист, 3-нов.страница, 4-символы гр., 5-скв.строки, 6-закрепление области
       
Public Type WebCell
        colspan As String
        rowspan As String
        value As String
        column As Integer
        style As String
        numformat As String
End Type
Public Type WebStyle
        text_align As String
        vertical_align As String
        mso_number_format As String
        white_space As String
        mso_text_control As String
        border_left As String
        border_right As String
        border_top As String
        border_bottom As String
        font_size As String
        font_weight As String
        font_family As String
        font_style As String
        text_decoration As String
        style As String
        mso_style_parent As String
        background As String
        color As String
        mso_pattern As String
        mso_char_indent_count As String
        mso_protection As String
End Type
Public Type WebStyles
    count As Integer
    wc() As WebStyle
End Type
Public Type WebCells
    count As Long
    row_height As Double
    wc() As WebCell
End Type
Public Type WebSheet
    name As String
    Zoom As String
    FitToPage As String
    FitWidth As String
    FitHeight As String
    PaperSizeIndex As String
    DisplayGridLines As String
    DisplayZeros As String
    TitleRows As String
    TitleColumns As String
    FreezePanes As String
    HB(5000) As Long
    HBCount As Integer
End Type
Public Type DataField
    column As Integer
    name As String
End Type
Public lcWebFile As String, lcStyleFile As String, lcWebDir As String, _
    lcTabStripFile As String, lcFileList As String, lcWorkBook As String, _
    wcs(65536) As WebCells, style As WebStyles, _
    ColWidth(256) As Double, _
    WebSheets(256) As WebSheet, WebSheetsCount As Integer, _
    st_col_width As String, st_table As String, _
    st_begin_sheet As String, st_end_sheet As String, st_main As String, _
    st_table_declare As String, st_style As String, st_filelist As String, _
    lcWebSheetFile As String, lcWebSheetName As String, _
    lbFreeze As Boolean, _
    st_tabstrip As String, DataFields(255) As DataField
       
Sub GetReport()
Dim ws As Object, lcString As String, lnPos As Integer, c As Range, r As Range, _
    d1 As Date, d2 As Date, d As Date, i As Long, j As Long, _
    lcField As String, lcRepSheets As String, lnRepSheet As Integer, _
    lcStringOrder As String, k As Integer, l As Integer, _
    TopColontitul As String, BotColontitul As String, St As String, _
    lcOutFile As String, lnCellsOrder As Integer, _
    lbGroupSheet As Boolean

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    
    repPath = Trim(ThisWorkbook.Sheets(1).[a2].value)
    repPath = repPath + IIf(repPath <> "", IIf(Mid(repPath, Len(repPath), 1) = "\", "", "\"), "")
    repName = Trim(ThisWorkbook.Sheets(1).[B2].value)
    dbPath = Trim(ThisWorkbook.Sheets(1).[C2].value)
    lcOutFile = Trim(ThisWorkbook.Sheets(1).[d2].value)
    If dbPath <> "" Then
        dbPath = dbPath + IIf(Mid(dbPath, Len(dbPath), 1) = "\", "", "\")
    End If

    ' Открываем шаблон документа
    Workbooks.Open fileName:=repPath + repName
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 1
    Range("A1").Select

    If lbStat Then
        dTime2 = Time()
        nTimeDiff = DateDiff("s", dTime1, dTime2)
        dTime1 = dTime2
        Call PrintFile(lcLogFile, 1, "  " & nTimeDiff & " сек - Открытие шаблона")
    End If

    lcStyleFile = dbPath + "stylesheet.css"
    lcTabStripFile = dbPath + "tabstrip.htm"
    lcFileList = dbPath + "filelist.xml"

    Call InitStyle

    Call PrintFile(lcOutFile, 0, "declare @cReport varchar(50), @cCode varchar(50), @nReportLink int")
    Call PrintFile(lcOutFile, 1, "select @cReport = '" + Trim(repName) + "'")
    Call PrintFile(lcOutFile, 1, "select @cCode = 'SYS_XL_'+left(@cReport, len(@cReport)-4)")
    Call PrintFile(lcOutFile, 1, "if not exists(select * from object_var where code=@cCode)")
    Call PrintFile(lcOutFile, 1, "    Insert object_var(Object, name, code)")
    Call PrintFile(lcOutFile, 1, "    select (select link from s_objects where code='XL_REPORT'), @cReport, @cCode")
    Call PrintFile(lcOutFile, 1, "select @nReportLink = link from object_var where code=@cCode")
    Call PrintFile(lcOutFile, 1, "delete object_var_values where link_up=@nReportLink")
    Call PrintFile(lcOutFile, 1, "")

lnCellsOrder = 0

lnSheetsCount = ActiveWorkbook.Sheets.count
For lnSheet = 1 To lnSheetsCount

    Set wso = ActiveWorkbook.Sheets(lnSheet)
    wso.Activate
    lbGroupSheet = (wso.name = "Группы")
    
    Call f1(lbGroupSheet)
    lnLastRowsCount = wso.[g1]
    wso.Activate
    Set wsoRange = Range(Cells(1, 1), LastCell(Cells))
    Call AddStyle(wsoRange)
    st_col_width = ""
    
    If Not lbGroupSheet Then
        For i = 1 To wsoRange.Columns.count
            st_col_width = st_col_width & StrReplace(wsoRange.Columns(wsoRange(1).column + i - 1).ColumnWidth, ",", ".") & "," & StrReplace(wsoRange.Columns(wsoRange(1).column + i - 1).Width, ",", ".") & Chr(10)
        Next i
    End If
    
    st_begin_sheet = GetWebSheetBegin(wsoRange, "")
    lcString = Trim(Range("c1").FormulaLocal) & "|" & Trim(Range("d1").FormulaLocal) & "|" & Trim(Range("e1").FormulaLocal) & "|" & Trim(Range("f1").FormulaLocal) & "|" & Trim([g1].FormulaLocal) & "|" & Trim(Range("k1").FormulaLocal) & "|"
    
    TopColontitul = IIf(ActiveSheet.PageSetup.LeftHeader <> "", "&Л" + ActiveSheet.PageSetup.LeftHeader, "") + _
                    IIf(ActiveSheet.PageSetup.CenterHeader <> "", "&Ц" + ActiveSheet.PageSetup.CenterHeader, "") + _
                    IIf(ActiveSheet.PageSetup.RightHeader <> "", "&П" + ActiveSheet.PageSetup.RightHeader, "")
    BotColontitul = IIf(ActiveSheet.PageSetup.LeftFooter <> "", "&Л" + ActiveSheet.PageSetup.LeftFooter, "") + _
                    IIf(ActiveSheet.PageSetup.CenterFooter <> "", "&Ц" + ActiveSheet.PageSetup.CenterFooter, "") + _
                    IIf(ActiveSheet.PageSetup.RightFooter <> "", "&П" + ActiveSheet.PageSetup.RightFooter, "")
    TopColontitul = StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(TopColontitul, "&B", "&Ж"), "&P", "&С"), "&N", "&К"), "&D", "&Д"), "&T", "&В"), "&F", "&Ф"), "&A", "&Я")
    BotColontitul = StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(BotColontitul, "&B", "&Ж"), "&P", "&С"), "&N", "&К"), "&D", "&Д"), "&T", "&В"), "&F", "&Ф"), "&A", "&Я")
    BotColontitul = StrReplace(BotColontitul, Chr(10), "\000A")
    TopColontitul = StrReplace(TopColontitul, Chr(10), "\000A")
    lcString = lcString & TopColontitul & "|" & BotColontitul
    lcString = lcString & "|" & Trim(Range("h1").value) & "|" & Trim(Range("i1").value)
    lcString = lcString & "|" & Trim(Range("l1").value)
    lcString = lcString & "|" & IIf(lbGroupSheet, Trim(Range("a1").value), wso.name)

    Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
    Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_PROP'), '" + lcString + "'" + _
        ", " + IIf(lnSheetsCount > 1 And Not lbGroupSheet, Trim(Str(lnSheet)), IIf(lbGroupSheet, "999", "NULL")))
    Call PrintFile(lcOutFile, 1, "")

    If Not lbGroupSheet Then
        Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
        Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_HTM_HEADER'), '" + StrReplace(st_begin_sheet, "'", "''") + "'" + _
            ", " + IIf(lnSheetsCount > 1, Trim(Str(lnSheet)), "NULL"))
        Call PrintFile(lcOutFile, 1, "")
    
        Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
        Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_HTM_COLUMNS'), '" + st_col_width + "'" + _
            ", " + IIf(lnSheetsCount > 1, Trim(Str(lnSheet)), "NULL"))
        Call PrintFile(lcOutFile, 1, "")
    End If

    St = ""
    For i = gStartPosDet To gEndPosDet
        l = 0
        For j = 1 To wsoRange.Columns.count
            If wso.Cells(i, j).WrapText Then
                l = 1
            End If
        Next j
        l = 0
        St = St & "0,1," & IIf(l = 0, StrReplace(wso.Rows(i).RowHeight, ",", "."), "") & Chr(10)
    Next i

    For k = 1 To groupCount
        For i = gStartPosH(k) To gEndPosH(k)
            l = 0
            For j = 1 To wsoRange.Columns.count
                If wso.Cells(i, j).WrapText Then
                    l = 1
                End If
            Next j
            l = 0
            St = St & k + IIf(lbGroupSheet, 100, 0) & ",1," & IIf(l = 0, StrReplace(wso.Rows(i).RowHeight, ",", "."), "") & Chr(10)
        Next i
        For i = gStartPosF(k) To gEndPosF(k)
            l = 0
            For j = 1 To wsoRange.Columns.count
                If wso.Cells(i, j).WrapText Then
                    l = 1
                End If
            Next j
            l = 0
            St = St & k + IIf(lbGroupSheet, 100, 0) & ",2," & IIf(l = 0, StrReplace(wso.Rows(i).RowHeight, ",", "."), "") & Chr(10)
        Next i
    Next k

    Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
    Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_HTM_ROWS'), '" + St + "'" + _
        ", " + IIf(lnSheetsCount > 1 And Not lbGroupSheet, Trim(Str(lnSheet)), IIf(lbGroupSheet, "999", "NULL")))
    Call PrintFile(lcOutFile, 1, "")
    For k = 1 To groupCount
        St = ""
        For i = gStartPosH(k) To gEndPosH(k)
            For j = 1 To wcs(i).count
                St = St & (k + IIf(lbGroupSheet, 100, 0)) & ",1,''" & StrInsertSeparator(Trim(StrReplace(StrReplace(StrReplace(wso.Cells(i, wcs(i).wc(j).column).value, "'", "''''"), Chr(10), "chr(10)"), Chr(13), " ")), 200, "''+''") & "''," & _
                          wcs(i).wc(j).rowspan & "," & wcs(i).wc(j).colspan & "," & (i - gStartPosH(k) + 1) & "," & _
                          wcs(i).wc(j).column & "," & _
                          "''" & wcs(i).wc(j).style & "'',"
                If InStr(1, wso.Cells(i, wcs(i).wc(j).column).NumberFormat, "0") > 0 And wso.Cells(i, wcs(i).wc(j).column).NumberFormat <> "0" Then
                    St = St & "''" & wso.Cells(i, wcs(i).wc(j).column).NumberFormat & "''"
                Else
                    St = St & "''''"
                End If
                If lnSheetsCount > 1 And Not lbGroupSheet Then
                    St = St & "," & lnSheet
                End If
              
                If Not wso.Cells(i, wcs(i).wc(j).column).Comment Is Nothing Then
                    St = St & ",''note:" & StrInsertSeparator(Trim(StrReplace(StrReplace(wso.Cells(i, wcs(i).wc(j).column).Comment.Text, "'", "''''"), Chr(10), "chr(10)")), 200, "''+''") & "''"
                End If
                
                St = St & Chr(10)
                If Len(St) > 5000 Then
                    lnCellsOrder = lnCellsOrder + 1
                    Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
                    Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_CELLS'), '" & St & "'," & lnCellsOrder)
                    Call PrintFile(lcOutFile, 1, "")
                    St = ""
                End If
            Next j
        Next i
        For i = gStartPosF(k) To gEndPosF(k)
            For j = 1 To wcs(i).count
                St = St & (k + IIf(lbGroupSheet, 100, 0)) & ",2,''" & StrInsertSeparator(Trim(StrReplace(wso.Cells(i, wcs(i).wc(j).column).value, "'", "''''")), 200, "''+''") & "''," & _
                          wcs(i).wc(j).rowspan & "," & wcs(i).wc(j).colspan & "," & _
                          (i - gStartPosF(k) + 1) & "," & _
                          wcs(i).wc(j).column & "," & _
                          "''" & wcs(i).wc(j).style & "'',"
                If InStr(1, wso.Cells(i, wcs(i).wc(j).column).NumberFormat, "0") > 0 And wso.Cells(i, wcs(i).wc(j).column).NumberFormat <> "0" Then
                    St = St & "''" & wso.Cells(i, wcs(i).wc(j).column).NumberFormat & "''"
                Else
                    St = St & "''''"
                End If
                If lnSheetsCount > 1 And Not lbGroupSheet Then
                    St = St & "," & lnSheet
                End If
                
                If Not wso.Cells(i, wcs(i).wc(j).column).Comment Is Nothing Then
                    St = St & ",''note:" & StrInsertSeparator(Trim(StrReplace(StrReplace(wso.Cells(i, wcs(i).wc(j).column).Comment.Text, "'", "''''"), Chr(10), "chr(10)")), 200, "''+''") & "''"
                End If
                
                St = St & Chr(10)
                If Len(St) > 5000 Then
                    lnCellsOrder = lnCellsOrder + 1
                    Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
                    Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_CELLS'), '" & St & "'," & lnCellsOrder)
                    Call PrintFile(lcOutFile, 1, "")
                    St = ""
                End If
            Next j
        Next i
        If St <> "" Then
            lnCellsOrder = lnCellsOrder + 1
            Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
            Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_CELLS'), '" & St & "'," & lnCellsOrder)
            Call PrintFile(lcOutFile, 1, "")
        End If
    Next k
    St = ""
    For i = gStartPosDet To gEndPosDet
        For j = 1 To wcs(i).count
            St = St & "0,1,''" & StrInsertSeparator(Trim(StrReplace(wso.Cells(i, wcs(i).wc(j).column).value, "'", "''''")), 200, "''+''") & "''," & _
                      wcs(i).wc(j).rowspan & "," & wcs(i).wc(j).colspan & "," & _
                      (i - gStartPosDet + 1) & "," & _
                      wcs(i).wc(j).column & "," & _
                      "''" & wcs(i).wc(j).style & "'',"
            If InStr(1, wso.Cells(i, wcs(i).wc(j).column).NumberFormat, "0") > 0 And wso.Cells(i, wcs(i).wc(j).column).NumberFormat <> "0" Then
                St = St & "''" & wso.Cells(i, wcs(i).wc(j).column).NumberFormat & "''"
            Else
                St = St & "''''"
            End If
            If lnSheetsCount > 1 And Not lbGroupSheet Then
                St = St & "," & lnSheet
            End If
            
            If Not wso.Cells(i, wcs(i).wc(j).column).Comment Is Nothing Then
                St = St & ",''note:" & StrInsertSeparator(Trim(StrReplace(StrReplace(wso.Cells(i, wcs(i).wc(j).column).Comment.Text, "'", "''''"), Chr(10), "chr(10)")), 200, "''+''") & "''"
            End If
            
            St = St & Chr(10)
            If Len(St) > 5000 Then
                lnCellsOrder = lnCellsOrder + 1
                Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
                Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_CELLS'), '" & St & "'," & lnCellsOrder)
                Call PrintFile(lcOutFile, 1, "")
                St = ""
            End If
        Next j
    Next i
    If St <> "" Then
        lnCellsOrder = lnCellsOrder + 1
        Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
        Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_CELLS'), '" & St & "'," & lnCellsOrder)
        Call PrintFile(lcOutFile, 1, "")
    End If

    If lbGroupSheet Then
        St = "update object_var_values set value=replace(value,',1'+char(10),char(10)) where link_up=@nReportLink and property=dbo.prop_id('XL_REPORT_CELLS')" & Chr(10)
        Call PrintFile(lcOutFile, 1, St)
        St = "update object_var_values set value=replace(value,',1,''note', ',''note') where link_up=@nReportLink and property=dbo.prop_id('XL_REPORT_CELLS')" & Chr(10)
        Call PrintFile(lcOutFile, 1, St)
    End If

    St = ""
    For i = 1 To groupCount
        St = St & i & ",''" & groupProp(i, 0) & "''," & _
                 IIf(groupProp(i, 2), 1, 0) & "," & _
                 IIf(groupProp(i, 3), 1, 0) & "," & _
                 IIf(groupProp(i, 4), 1, 0) & "," & _
                 IIf(groupProp(i, 5), 1, 0) & "," & _
                 IIf(groupProp(i, 6), 1, 0) & ","
        lcString = groupProp(i, 12)
        St = St & "''" & StrReplace(lcString, "'", "''''") & "'',"
        lcString = groupProp(i, 13)
        St = St & "''" & StrReplace(lcString, "'", "''''") & "''" & Chr(10)
    Next i
    lcString = groupProp(0, 12)
    St = St & "0,'''',0,0,0,0,0,''" & StrReplace(lcString, "'", "''''") & "'',''''" & Chr(10)
    Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
    Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_GROUPS'), '" & St & "'" + _
        ", " + IIf(lnSheetsCount > 1 And Not lbGroupSheet, Trim(Str(lnSheet)), IIf(lbGroupSheet, "999", "NULL")))
    Call PrintFile(lcOutFile, 1, "")

Next lnSheet

    St = "tr" + Chr(10) + Chr(9) + "{mso-height-source:auto;}" + Chr(10)
    St = St + "col" + Chr(10) + Chr(9) + "{mso-width-source:auto;}" + Chr(10)
    St = St + "br" + Chr(10) + Chr(9) + "{mso-data-placement:same-cell;}" + Chr(10)
    St = St + "." + style.wc(0).style + Chr(10) + _
              Chr(9) + "{font-family:""" + style.wc(0).font_family + """;" + Chr(10) + _
              Chr(9) + "font-size:" + style.wc(0).font_size + ";" + Chr(10) + _
              Chr(9) + "font-style:" + style.wc(0).font_style + ";" + Chr(10) + _
              Chr(9) + "font-weight:" + style.wc(0).font_weight + ";" + Chr(10) + _
              Chr(9) + "mso-number-format:" + IIf(style.wc(0).mso_number_format <> "0", """" + style.wc(0).mso_number_format + """", """@@""") + ";" + Chr(10) + _
              Chr(9) + "mso-text-control:" + style.wc(0).mso_text_control + ";" + Chr(10) + _
              Chr(9) + "text-align:" + style.wc(0).text_align + ";" + Chr(10) + _
              Chr(9) + "text-decoration:" + style.wc(0).text_decoration + ";" + Chr(10) + _
              Chr(9) + "vertical-align:" + style.wc(0).vertical_align + ";" + Chr(10) + _
              Chr(9) + "white-space:" + style.wc(0).white_space + ";" + Chr(10) + _
              Chr(9) + "mso-rotate:0;" + Chr(10) + _
              Chr(9) + "mso-background-source:auto;" + Chr(10) + _
              Chr(9) + "color:windowtext;" + Chr(10) + _
              Chr(9) + "mso-generic-font-family:auto;" + Chr(10) + _
              Chr(9) + "mso-font-charset:204;" + Chr(10) + _
              Chr(9) + "border:none;" + Chr(10) + _
              IIf(style.wc(0).mso_pattern <> "", _
                  Chr(9) + "mso-pattern:" + style.wc(0).mso_pattern + ";" + Chr(10), "") + _
              Chr(9) + "mso-protection:locked visible;" + Chr(10) + _
              Chr(9) + "mso-style-name:Обычный;" + Chr(10) + _
              Chr(9) + "mso-style-id:0;}" + Chr(10)
    St = St + "td" + Chr(10) + _
              Chr(9) + "{mso-style-parent:" + style.wc(0).style + Chr(10) + _
              Chr(9) + "padding-top:1px;padding-right:1px;padding-left:1px;mso-ignore:padding;" + Chr(10) + _
              Chr(9) + "font-family:""" + style.wc(0).font_family + """;" + Chr(10) + _
              Chr(9) + "font-size:" + style.wc(0).font_size + ";" + Chr(10) + _
              Chr(9) + "font-style:" + style.wc(0).font_style + ";" + Chr(10) + _
              Chr(9) + "font-weight:" + style.wc(0).font_weight + ";" + Chr(10) + _
              Chr(9) + "mso-number-format:" + IIf(style.wc(0).mso_number_format <> "0", """" + style.wc(0).mso_number_format + """", """@@""") + ";" + Chr(10) + _
              Chr(9) + "mso-text-control:" + style.wc(0).mso_text_control + ";" + Chr(10) + _
              Chr(9) + "text-align:" + style.wc(0).text_align + ";" + Chr(10) + _
              Chr(9) + "text-decoration:" + style.wc(0).text_decoration + ";" + Chr(10) + _
              Chr(9) + "vertical-align:" + style.wc(0).vertical_align + ";" + Chr(10) + _
              Chr(9) + "white-space:" + style.wc(0).white_space + ";" + Chr(10) + _
              Chr(9) + "mso-rotate:0;" + Chr(10) + _
              Chr(9) + "mso-background-source:auto;" + Chr(10) + _
              Chr(9) + "color:windowtext;" + Chr(10) + _
              Chr(9) + "mso-generic-font-family:auto;" + Chr(10) + _
              Chr(9) + "mso-font-charset:204;" + Chr(10) + _
              Chr(9) + "border:none;" + Chr(10) + _
              IIf(style.wc(0).mso_pattern <> "", _
                  Chr(9) + "mso-pattern:" + style.wc(0).mso_pattern + ";" + Chr(10), "") + _
              Chr(9) + "mso-protection:locked visible;}" + Chr(10)
    j = 0
    Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
    Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_HTM_STYLES'), '" + StrReplace(St, "'", "''") + "'," & j)
    St = ""
    For i = 1 To style.count
        With style.wc(i)
            St = St + "." + style.wc(i).style + Chr(10) + _
            Chr(9) + "{mso-style-parent:" + style.wc(i).mso_style_parent + ";" + Chr(10) + _
            IIf(.font_family <> style.wc(0).font_family, _
                Chr(9) + "font-family:""" + style.wc(i).font_family + """;" + Chr(10), "") + _
            IIf(.font_size <> style.wc(0).font_size, _
                Chr(9) + "font-size:" + style.wc(i).font_size + ";" + Chr(10), "") + _
            IIf(.font_style <> style.wc(0).font_style, _
                Chr(9) + "font-style:" + style.wc(i).font_style + ";" + Chr(10), "") + _
            IIf(.font_weight <> style.wc(0).font_weight, _
                Chr(9) + "font-weight:" + style.wc(i).font_weight + ";" + Chr(10), "") + _
            IIf(.mso_number_format <> style.wc(0).mso_number_format, _
                Chr(9) + "mso-number-format:" + IIf(style.wc(i).mso_number_format <> "0", """" + style.wc(i).mso_number_format + """", """@@""") + ";" + Chr(10), "") + _
            IIf(.mso_text_control <> style.wc(0).mso_text_control, _
                Chr(9) + "mso-text-control:" + style.wc(i).mso_text_control + ";" + Chr(10), "") + _
            IIf(.text_align <> style.wc(0).text_align, _
                Chr(9) + "text-align:" + style.wc(i).text_align + ";" + Chr(10), "") + _
            IIf(.text_decoration <> style.wc(0).text_decoration, _
                Chr(9) + "text-decoration:" + style.wc(i).text_decoration + ";" + Chr(10), "") + _
            IIf(.mso_char_indent_count <> "", _
                Chr(9) + "mso-char-indent-count:" + style.wc(i).mso_char_indent_count + ";" + Chr(10), "")
            St = St + _
            IIf(.mso_protection <> "", _
                Chr(9) + "mso-protection:" + style.wc(i).mso_protection + ";" + Chr(10), "") + _
            IIf(.vertical_align <> style.wc(0).vertical_align, _
                Chr(9) + "vertical-align:" + style.wc(i).vertical_align + ";" + Chr(10), "") + _
            IIf(.white_space <> style.wc(0).white_space, _
                Chr(9) + "white-space:" + style.wc(i).white_space + ";" + Chr(10), "")
            St = St + _
            IIf(.border_bottom <> "", _
                Chr(9) + "border-bottom:" + style.wc(i).border_bottom + ";" + Chr(10), "") + _
            IIf(.border_left <> "", _
                Chr(9) + "border-left:" + style.wc(i).border_left + ";" + Chr(10), "") + _
            IIf(.border_right <> "", _
                Chr(9) + "border-right:" + style.wc(i).border_right + ";" + Chr(10), "") + _
            IIf(.border_top <> "", _
                Chr(9) + "border-top:" + style.wc(i).border_top + ";" + Chr(10), "") + _
            IIf(.background <> "", _
                Chr(9) + "background:" + style.wc(i).background + ";" + Chr(10), "") + _
            IIf(.color <> "", _
                Chr(9) + "color:" + style.wc(i).color + ";" + Chr(10), "") + _
            Chr(9) + "}" + Chr(10)
        End With
        j = Val(Mid(style.wc(i).style, 3, Len(style.wc(i).style) - 2))
        Call PrintFile(lcOutFile, 1, "insert object_var_values (link_up, property, value, orders)")
        Call PrintFile(lcOutFile, 1, "select @nReportLink, dbo.prop_id('XL_REPORT_HTM_STYLES'), '" + StrReplace(St, "'", "''") + "'," & j)
        St = ""
    Next i

    Call PrintFile(lcOutFile, 1, "")



    Application.ActiveWorkbook.Close
    Application.ThisWorkbook.Close
End Sub

Sub f1(Optional notDet As Boolean)
Dim i As Integer, c As Range, lB As Boolean
    groupCount = wso.[B1].value
    gEndPosH(0) = 0       ' Конечная строка шапки группы
    For i = 1 To groupCount
        gStartPosH(i) = gEndPosH(i - 1) + 2 ' Начальная строка шапки группы
        gEndPosH(i) = gEndPosH(i - 1) + 1
        Do While Not (wso.Cells(gEndPosH(i) + 1, 1).value Like "^ Шапка*")
            gEndPosH(i) = gEndPosH(i) + 1
        Loop
        groupProp(i, 0) = wso.Cells(gEndPosH(i) + 1, 2).value
        If Not c Is Nothing Then
            groupProp(i, 1) = c.column
        Else
            groupProp(i, 1) = 0
        End If
        groupProp(i, 14) = wso.Cells(gEndPosH(i) + 1, 2).value
        groupProp(i, 2) = wso.Cells(gEndPosH(i) + 1, 3).value
        groupProp(i, 3) = wso.Cells(gEndPosH(i) + 1, 4).value
        groupProp(i, 4) = wso.Cells(gEndPosH(i) + 1, 5).value
        groupProp(i, 5) = wso.Cells(gEndPosH(i) + 1, 6).value
        lB = wso.Cells(gEndPosH(i) + 1, 7).value
        groupProp(i, 6) = lB
        groupProp(i, 7) = True  'Группа начинается на новом листе
        groupProp(i, 8) = True  'Группа начинается на новой странице
        groupProp(i, 9) = wso.Cells(gEndPosH(i) + 1, 9).value   'Дополнительная команда
        groupProp(i, 10) = 0    ' Строка начала группы в выходном отчете
        groupProp(i, 11) = 0    ' Номер группы
        groupProp(i, 12) = wso.Cells(gEndPosH(i) + 1, 8).value ' Условие вывода
    Next i
    
    gStartPosDet = gEndPosH(groupCount) + 2 ' Начальная строка Detail
    gEndPosDet = gEndPosH(groupCount) + 1   ' Конечная строка Detail
    If Not notDet Then
        Do While Not (wso.Cells(gEndPosDet + 1, 1).value Like "^ Данные*")
            gEndPosDet = gEndPosDet + 1
        Loop
        groupProp(0, 12) = wso.Cells(gEndPosDet + 1, 8).value ' Условие вывода
    Else
        groupProp(0, 12) = False ' Условие вывода
    End If
    gEndPosF(groupCount + 1) = gEndPosDet - IIf(notDet, 1, 0)        ' Конечная строка концовки группы
    
    For i = groupCount To 1 Step -1
        gStartPosF(i) = gEndPosF(i + 1) + 2 ' Начальная строка концовки группы
        gEndPosF(i) = gEndPosF(i + 1) + 1
        Do While Not (wso.Cells(gEndPosF(i) + 1, 1).value Like "^ Концовка*")
            gEndPosF(i) = gEndPosF(i) + 1
        Loop
        groupProp(i, 13) = wso.Cells(gEndPosF(i) + 1, 8).value ' Условие вывода
    Next i
    Set c = Nothing
End Sub


Function LastCell(r As Range) As Range
Dim rLast As Range
    Set rLast = r.Cells.SpecialCells(xlLastCell)
    If rLast.Cells(1, 1).value = "" Then
        On Error Resume Next
        Set LastCell = r.Parent.Cells(r.Parent.Cells.Find("*", rLast, xlFormulas, , xlByRows, xlPrevious).Row, r.Parent.Cells.Find("*", rLast, xlFormulas, , xlByColumns, xlPrevious).column)
        If Err.Number <> 0 Then Set LastCell = r.Parent.Cells(1, 1)
        On Error GoTo 0
    Else
        Set LastCell = rLast
    End If
    Set rLast = Nothing
End Function


Function GetStrParam(lcParam As String, ByVal lnParam As Integer) As String
Dim nPos1 As Integer, nPos2 As Integer, i As Integer
    nPos1 = 0
    i = 1
    While i < lnParam
        nPos1 = InStr(nPos1 + 1, lcParam, "#")
        If nPos1 = 0 Then
            GetStrParam = ""
            Exit Function
        End If
        i = i + 1
    Wend
    nPos2 = InStr(nPos1 + 1, lcParam, "#")
    nPos2 = IIf(nPos2 = 0, Len(lcParam), nPos2 - 1)
    If nPos2 > nPos1 Then
        GetStrParam = Mid(lcParam, nPos1 + 1, nPos2 - nPos1)
    Else
        GetStrParam = ""
    End If
End Function

Function StrReplace(cWhere As String, cWhat As String, cRepl As String) As String
Dim n As Integer
    n = 1
    Do
        n = InStr(n, cWhere, cWhat)
        If n > 0 Then
            cWhere = Mid(cWhere, 1, n - 1) + cRepl + Mid(cWhere, n + Len(cWhat))
            n = n + Len(cRepl)
        End If
    Loop While n <> 0
    StrReplace = cWhere
End Function

Sub PrintFile(lcFile As String, lnMode As Integer, lcStr As String)
    If lnMode = 0 Then
        Open lcFile For Output As #1
    Else
        Open lcFile For Append As #1
    End If
    Print #1, lcStr
    Close #1
End Sub

Sub InitStyle()
Dim c As Object
    style.count = 0
    ReDim Preserve style.wc(1)
    Set c = ActiveWorkbook.Styles("Normal")
    With style.wc(0)
        .text_align = Switch(c.HorizontalAlignment = xlLeft, "left", _
            c.HorizontalAlignment = xlRight, "right", _
            c.HorizontalAlignment = xlCenter, "center", _
            c.HorizontalAlignment = xlGeneral, "general")
        .vertical_align = Switch(c.VerticalAlignment = xlTop, "top", _
            c.VerticalAlignment = xlBottom, "bottom", _
            c.VerticalAlignment = xlCenter, "middle")
        .white_space = IIf(c.WrapText, "normal", "nowrap")
        .mso_text_control = IIf(c.ShrinkToFit, "shrinktofit", "")
        .mso_number_format = c.NumberFormat
        .mso_number_format = StrReplace(.mso_number_format, "#", "\#")
        .mso_number_format = StrReplace(.mso_number_format, ",", "\,")
        .mso_number_format = StrReplace(.mso_number_format, ".", "\.")
        .font_family = c.Font.name
        .font_size = Trim(Str(c.Font.Size)) + "pt"
        .font_weight = IIf(c.Font.Bold, "700", "400")
        .text_decoration = IIf(c.Font.Underline = xlUnderlineStyleSingle, "underline", "none")
        .font_style = IIf(c.Font.Italic, "italic", "normal")
        .style = "style0"
        .background = IIf(c.Interior.ColorIndex <> xlColorIndexNone, "#" + StrReverse(Hex(c.Interior.color)), "")
        .color = "#" + Hex(c.Font.color)
        .mso_pattern = IIf(c.Interior.Pattern = xlPatternNone, "auto none", "")
    End With
End Sub

Sub AddStyle(r As Range)
Dim c As Range, rc As Integer, cAddr1 As String, cAddr2 As String, _
    cValue As String, tableWidth As Double, _
    i As Integer, j As Integer, k As Integer, b As Boolean, _
    rHeight As Double, ws As WebStyle, _
    fval As String

    For i = r(1).Row To r(1).Row + r.Rows.count - 1
        wcs(i).row_height = 0
        wcs(i).count = 0
    Next i
    For Each c In r
        If c.Address(False, False, xlA1) = c.MergeArea(1).Address(False, False, xlA1) Then
            On Error GoTo ErrAddr:
            cValue = c.Text
            rc = c.Row
            wcs(rc).count = wcs(rc).count + 1
            ReDim Preserve wcs(rc).wc(wcs(rc).count)
            With ws
                wcs(rc).wc(wcs(rc).count).value = cValue
                wcs(rc).wc(wcs(rc).count).column = c.column - r(1).column + 1
                wcs(rc).wc(wcs(rc).count).colspan = Trim(Str(c.MergeArea.Columns.count))
                wcs(rc).wc(wcs(rc).count).rowspan = Trim(Str(c.MergeArea.Rows.count))
                If wcs(rc).wc(wcs(rc).count).rowspan > 1 Then
                    For i = 1 To wcs(rc).wc(wcs(rc).count).rowspan - 1
                        wcs(rc + i).row_height = -1
                    Next i
                End If
                If Not c.WrapText And c.MergeArea.Rows.count = 1 Then
                    If wcs(rc).row_height >= 0 Then
                        wcs(rc).row_height = IIf(c.Height > wcs(rc).row_height, c.Height, wcs(rc).row_height)
                    End If
                Else
                    wcs(rc).row_height = -1
                End If
                .text_align = Switch(IsNull(c.MergeArea.HorizontalAlignment), "left", _
                    c.MergeArea.HorizontalAlignment = xlLeft, "left", _
                    c.MergeArea.HorizontalAlignment = xlRight, "right", _
                    c.MergeArea.HorizontalAlignment = xlCenter, "center", _
                    c.MergeArea.HorizontalAlignment = -10130 Or c.MergeArea.HorizontalAlignment = xlGeneral Or c.MergeArea.HorizontalAlignment = xlHAlignCenterAcrossSelection, "general")
                .vertical_align = Switch(c.MergeArea.VerticalAlignment = xlTop, "top", _
                    c.MergeArea.VerticalAlignment = xlBottom, "bottom", _
                    c.MergeArea.VerticalAlignment = xlCenter, "middle", _
                    c.MergeArea.VerticalAlignment <> xlTop And c.MergeArea.VerticalAlignment <> xlBottom And c.MergeArea.VerticalAlignment <> xlCenter, "bottom")
                .white_space = IIf(c.MergeArea.WrapText, "normal", "nowrap")
                .mso_text_control = IIf(c.MergeArea.ShrinkToFit, "shrinktofit", "")
                .mso_number_format = c.MergeArea.NumberFormat
                .mso_number_format = StrReplace(.mso_number_format, "#", "\#")
                .mso_number_format = StrReplace(.mso_number_format, ",", "\,")
                .mso_number_format = StrReplace(.mso_number_format, ".", "\.")
                .font_family = c.MergeArea.Font.name
                .font_size = Trim(Str(c.Font.Size)) + "pt"
                .font_weight = IIf(c.MergeArea.Font.Bold, "700", "400")
                .text_decoration = IIf(c.MergeArea.Font.Underline = xlUnderlineStyleSingle, "underline", "none")
                .font_style = IIf(c.MergeArea.Font.Italic, "italic", "normal")
                .mso_char_indent_count = IIf(c.MergeArea.IndentLevel > 0, "" & c.MergeArea.IndentLevel, "")
                .mso_protection = IIf(c.MergeArea.Locked, "", "unlocked visible")
'EdiS
                If c.MergeArea.Borders(xlEdgeLeft).LineStyle <> xlNone Then
                    .border_left = Switch(c.MergeArea.Borders(xlEdgeLeft).LineStyle = xlDouble, "2.5pt double windowtext", _
                        c.MergeArea.Borders(xlEdgeLeft).Weight = xlThin, ".5pt solid  windowtext", _
                        c.MergeArea.Borders(xlEdgeLeft).Weight = xlMedium, "1.0pt solid  windowtext", _
                        c.MergeArea.Borders(xlEdgeLeft).Weight = xlThick, "1.5pt solid  windowtext", _
			c.MergeArea.Borders(xlEdgeLeft).Weight = xlContinuous, ".5pt hairline windowtext", _
                        c.MergeArea.Borders(xlEdgeLeft).Weight = xlHairline, "")
                Else
                    .border_left = ""
                End If
                If c.MergeArea.Borders(xlEdgeRight).LineStyle <> xlNone Then
                    .border_right = Switch(c.MergeArea.Borders(xlEdgeRight).LineStyle = xlDouble, "2.5pt double windowtext", _
                        c.MergeArea.Borders(xlEdgeRight).Weight = xlThin, ".5pt solid  windowtext", _
                        c.MergeArea.Borders(xlEdgeRight).Weight = xlMedium, "1.0pt solid  windowtext", _
                        c.MergeArea.Borders(xlEdgeRight).Weight = xlThick, "1.5pt solid  windowtext", _
			c.MergeArea.Borders(xlEdgeRight).Weight = xlContinuous, ".5pt hairline windowtext", _
                        c.MergeArea.Borders(xlEdgeRight).Weight = xlHairline, "")
                Else
                    .border_right = ""
                End If
                If c.MergeArea.Borders(xlEdgeTop).LineStyle <> xlNone Then
                    .border_top = Switch(c.MergeArea.Borders(xlEdgeTop).LineStyle = xlDouble, "2.5pt double windowtext", _
                        c.MergeArea.Borders(xlEdgeTop).Weight = xlThin, ".5pt solid  windowtext", _
                        c.MergeArea.Borders(xlEdgeTop).Weight = xlMedium, "1.0pt solid  windowtext", _
                        c.MergeArea.Borders(xlEdgeTop).Weight = xlThick, "1.5pt solid  windowtext", _
			c.MergeArea.Borders(xlEdgeTop).Weight = xlContinuous, ".5pt hairline windowtext", _
                        c.MergeArea.Borders(xlEdgeTop).Weight = xlHairline, "")
                Else
                    .border_top = ""
                End If
                If c.MergeArea.Borders(xlEdgeBottom).LineStyle <> xlNone Then
                    .border_bottom = Switch(c.MergeArea.Borders(xlEdgeBottom).LineStyle = xlDouble, "2.5pt double windowtext", _
                        c.MergeArea.Borders(xlEdgeBottom).Weight = xlThin, ".5pt solid  windowtext", _
                        c.MergeArea.Borders(xlEdgeBottom).Weight = xlMedium, "1.0pt solid  windowtext", _
                        c.MergeArea.Borders(xlEdgeBottom).Weight = xlThick, "1.5pt solid  windowtext", _
			c.MergeArea.Borders(xlEdgeBottom).Weight = xlContinuous, ".5pt hairline windowtext", _
                        c.MergeArea.Borders(xlEdgeBottom).Weight = xlHairline, "")
                Else
                    .border_bottom = ""
                End If
                .background = IIf(c.MergeArea.Interior.ColorIndex <> xlColorIndexNone, "#" + StrReverse(Hex(c.MergeArea.Interior.color)), "")
                .color = "#" + Hex(c.MergeArea.Font.color)
                b = False
                For k = 1 To style.count
                    b = _
                    (.border_bottom = style.wc(k).border_bottom) And _
                    (.border_left = style.wc(k).border_left) And _
                    (.border_right = style.wc(k).border_right) And _
                    (.border_top = style.wc(k).border_top) And _
                    (.font_family = style.wc(k).font_family) And _
                    (.font_size = style.wc(k).font_size) And _
                    (.font_style = style.wc(k).font_style) And _
                    (.font_weight = style.wc(k).font_weight) And _
                    (.mso_number_format = style.wc(k).mso_number_format) And _
                    (.mso_text_control = style.wc(k).mso_text_control) And _
                    (.text_align = style.wc(k).text_align) And _
                    (.text_decoration = style.wc(k).text_decoration) And _
                    (.mso_char_indent_count = style.wc(k).mso_char_indent_count) And _
                    (.mso_protection = style.wc(k).mso_protection) And _
                    (.vertical_align = style.wc(k).vertical_align) And _
                    (.background = style.wc(k).background) And _
                    (.color = style.wc(k).color) And _
                    (.white_space = style.wc(k).white_space)
                    If b Then Exit For
                Next k
                If b Then
                    .style = style.wc(k).style
                Else
                    style.count = style.count + 1
                    ReDim Preserve style.wc(style.count)
                    style.wc(style.count).style = "xl" + Trim(Str(style.count + 20))
                    .style = style.wc(style.count).style
                    style.wc(style.count).mso_style_parent = style.wc(0).style
                    style.wc(style.count).border_bottom = .border_bottom
                    style.wc(style.count).border_left = .border_left
                    style.wc(style.count).border_right = .border_right
                    style.wc(style.count).border_top = .border_top
                    style.wc(style.count).font_family = .font_family
                    style.wc(style.count).font_size = .font_size
                    style.wc(style.count).font_style = .font_style
                    style.wc(style.count).font_weight = .font_weight
                    style.wc(style.count).mso_number_format = .mso_number_format
                    style.wc(style.count).mso_text_control = .mso_text_control
                    style.wc(style.count).text_align = .text_align
                    style.wc(style.count).text_decoration = .text_decoration
                    style.wc(style.count).mso_char_indent_count = .mso_char_indent_count
                    style.wc(style.count).mso_protection = .mso_protection
                    style.wc(style.count).vertical_align = .vertical_align
                    style.wc(style.count).white_space = .white_space
                    style.wc(style.count).background = .background
                    style.wc(style.count).color = .color
                End If
                wcs(rc).wc(wcs(rc).count).style = .style
            End With
            GoTo NotErrAddr:
ErrAddr:    MsgBox ("Ошибка по адресу: " & c.Address(False, False, xlA1, True))
NotErrAddr: On Error GoTo 0
        End If
    Next c
End Sub

Function GetWebSheetBegin(r As Range, Optional TopColontitul As String = "") As String
Dim i As Integer, St As String, BotColontitul As String
    St = ""
    If TopColontitul = "" Then
        TopColontitul = IIf(ActiveSheet.PageSetup.LeftHeader <> "", "&Л" + ActiveSheet.PageSetup.LeftHeader, "") + _
                        IIf(ActiveSheet.PageSetup.CenterHeader <> "", "&Ц" + ActiveSheet.PageSetup.CenterHeader, "") + _
                        IIf(ActiveSheet.PageSetup.RightHeader <> "", "&П" + ActiveSheet.PageSetup.RightHeader, "")
    End If
    BotColontitul = IIf(ActiveSheet.PageSetup.LeftFooter <> "", "&Л" + ActiveSheet.PageSetup.LeftFooter, "") + _
                    IIf(ActiveSheet.PageSetup.CenterFooter <> "", "&Ц" + ActiveSheet.PageSetup.CenterFooter, "") + _
                    IIf(ActiveSheet.PageSetup.RightFooter <> "", "&П" + ActiveSheet.PageSetup.RightFooter, "")
    TopColontitul = StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(TopColontitul, "&B", "&Ж"), "&P", "&С"), "&N", "&К"), "&D", "&Д"), "&T", "&В"), "&F", "&Ф"), "&A", "&Я")
    BotColontitul = StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(StrReplace(BotColontitul, "&B", "&Ж"), "&P", "&С"), "&N", "&К"), "&D", "&Д"), "&T", "&В"), "&F", "&Ф"), "&A", "&Я")

    BotColontitul = StrReplace(BotColontitul, Chr(10), "\000A")
    TopColontitul = StrReplace(TopColontitul, Chr(10), "\000A")

    lcStyleOptions = _
              "<style>" + Chr(10) + _
              "<!--table" + Chr(10) + _
              Chr(9) + "{mso-displayed-decimal-separator:""\,"";" + Chr(10) + _
              Chr(9) + "mso-displayed-thousand-separator:"" "";}" + Chr(10)
    lcStyleOptions = lcStyleOptions + _
              "@page" + Chr(10) + _
              Chr(9) + "{margin:" + _
              Trim(Str(r.Parent.PageSetup.TopMargin / 72)) + "in " + _
              Trim(Str(r.Parent.PageSetup.RightMargin / 72)) + "in " + _
              Trim(Str(r.Parent.PageSetup.BottomMargin / 72)) + "in " + _
              Trim(Str(r.Parent.PageSetup.LeftMargin / 72)) + "in;" + Chr(10) + _
              Chr(9) + "mso-header-margin:" + Trim(Str(r.Parent.PageSetup.HeaderMargin / 72)) + "in;" + Chr(10) + _
              Chr(9) + "mso-footer-margin:" + Trim(Str(r.Parent.PageSetup.FooterMargin / 72)) + "in;" + _
              IIf(TopColontitul <> "", Chr(10) + Chr(9) + "mso-header-data:""" + TopColontitul + """;", "") + _
              IIf(BotColontitul <> "", Chr(10) + Chr(9) + "mso-footer-data:""" + BotColontitul + """;", "") + _
              IIf(ActiveSheet.PageSetup.Orientation = xlLandscape, Chr(10) + Chr(9) + "mso-page-orientation:landscape;", "") + _
              "}" + Chr(10)
    lcStyleOptions = lcStyleOptions + _
              "-->" + Chr(10) + _
              "</style>" + Chr(10)

    St = St + "<html xmlns:v=""urn:schemas-microsoft-com:vml"" xmlns:x=""urn:schemas-microsoft-com:office:excel"">" + Chr(10) + "<head>" + Chr(10) + _
              "<meta name=ProgId content=Excel.Sheet>" + Chr(10) + _
              "<meta http-equiv=Content-Type content=""text/html; charset=windows-1251"">" + Chr(10) + _
              "<link rel=Stylesheet href=stylesheet.css>" + Chr(10) + _
              lcStyleOptions

    WebSheets(WebSheetsCount).DisplayGridLines = IIf(Not ActiveWindow.DisplayGridLines, "<x:DoNotDisplayGridlines/>", "")
    WebSheets(WebSheetsCount).DisplayZeros = IIf(Not ActiveWindow.DisplayZeros, "<x:DoNotDisplayZeros/>", "")
    WebSheets(WebSheetsCount).FitToPage = IIf(ActiveSheet.PageSetup.Zoom, "", "<x:FitToPage/>")

    WebSheets(WebSheetsCount).FitWidth = IIf(ActiveSheet.PageSetup.FitToPagesWide > 0, "<x:FitWidth>" + Trim(Str(ActiveSheet.PageSetup.FitToPagesWide)) + "</x:FitWidth>", "")
    WebSheets(WebSheetsCount).FitHeight = IIf(WebSheets(WebSheetsCount).FitToPage <> "" Or ActiveSheet.PageSetup.FitToPagesTall > 0, "<x:FitHeight>" + _
        IIf(ActiveSheet.PageSetup.FitToPagesTall > 0, Trim(Str(ActiveSheet.PageSetup.FitToPagesTall)), "0") + "</x:FitHeight>", "")

    WebSheets(WebSheetsCount).PaperSizeIndex = "<x:PaperSizeIndex>" + Trim(Str(ActiveSheet.PageSetup.PaperSize)) + "</x:PaperSizeIndex>"
    WebSheets(WebSheetsCount).FitToPage = IIf(ActiveSheet.PageSetup.Zoom, "", "<x:FitToPage/>")
    WebSheets(WebSheetsCount).Zoom = IIf(ActiveSheet.PageSetup.Zoom, "<x:Scale>" + Trim(Str(ActiveSheet.PageSetup.Zoom)) + "</x:Scale>", "")

    lcSheetOptions = _
              IIf(WebSheets(WebSheetsCount).FitToPage <> "", "     " + WebSheets(WebSheetsCount).FitToPage + Chr(10), "") + _
              "     <x:Print>" + Chr(10) + _
              IIf(WebSheets(WebSheetsCount).Zoom <> "", "      " + WebSheets(WebSheetsCount).Zoom + Chr(10), "") + _
              IIf(WebSheets(WebSheetsCount).PaperSizeIndex <> "", "      " + WebSheets(WebSheetsCount).PaperSizeIndex + Chr(10), "") + _
              IIf(WebSheets(WebSheetsCount).FitWidth <> "", "      " + WebSheets(WebSheetsCount).FitWidth + Chr(10), "") + _
              IIf(WebSheets(WebSheetsCount).FitHeight <> "", "      " + WebSheets(WebSheetsCount).FitHeight + Chr(10), "") + _
              "      <x:ValidPrinterInfo/>" + Chr(10) + _
              "     </x:Print>" + Chr(10) + _
              IIf(WebSheets(WebSheetsCount).DisplayGridLines <> "", "     " + WebSheets(WebSheetsCount).DisplayGridLines + Chr(10), "") + _
              IIf(WebSheets(WebSheetsCount).DisplayZeros <> "", "     " + WebSheets(WebSheetsCount).DisplayZeros + Chr(10), "")

    St = St + "<!--[if gte mso 9]><xml>" + Chr(10) + _
              "    <x:WorksheetOptions>" + Chr(10) + _
              lcSheetOptions + _
              "    </x:WorksheetOptions>" + Chr(10) + _
              "</xml><![endif]-->" + Chr(10)

    St = St + "</head>" + Chr(10) + _
              "<body>" + Chr(10)
    For i = 1 To r.Columns.count
        ColWidth(i) = r.Columns(r(1).column + i - 1).Width
    Next i
    curPosR = 1
    WebSheets(WebSheetsCount).TitleColumns = ActiveSheet.PageSetup.PrintTitleColumns
    WebSheets(WebSheetsCount).TitleRows = ActiveSheet.PageSetup.PrintTitleRows
    GetWebSheetBegin = St
End Function
              
Function StrInsertSeparator(St As String, nSize As Integer, Separator As String)
Dim resSt As String
    resSt = ""
    Do While Len(St) > nSize
        resSt = resSt + Mid(St, 1, nSize) + Separator
        St = Mid(St, nSize + 1, Len(St) - nSize)
    Loop
    resSt = resSt + St
    StrInsertSeparator = resSt
End Function
