Attribute VB_Name = "service_o"
Option Explicit

Public pnUser, dbPath, dbName, pnLogin, pnParol, pndbNameSql, _
        pnwrkODBC, pnwrkConnect, pUser_id, ToolbarAction


Public Function init_data(s As String) As Integer
Dim sheetsService
Dim Found As Boolean, cbar As Object, i As Integer
    Found = False
    For Each cbar In Application.CommandBars
        If cbar.Name = "Меню OUT" Then Found = True
    Next
    If Found Then Application.CommandBars("Меню OUT").Delete
'    Stop
    Set sheetsService = Application.ActiveWorkbook.Sheets.Add
    With sheetsService
        .Name = "Service"
        .Visible = xlSheetVeryHidden '2
        .Range("A1") = ActiveWorkbook.Names("dDate1").value
        If exists_name("dDate2") Then
            .Range("A2") = ActiveWorkbook.Names("dDate2").value
        Else
            .Range("A2") = ActiveWorkbook.Names("dDate1").value
        End If
        .Range("A3") = ActiveWorkbook.Names("User_Name").value
        .Range("A4") = ActiveWorkbook.Names("Chef_FIO").value
        .Range("A5") = ActiveWorkbook.Names("Boss_FIO").value
        .Range("A6") = ActiveWorkbook.Names("Buh_FIO").value
        .Range("A7") = ActiveWorkbook.Names("Zam_Boss_FIO").value
        .Range("A8") = ActiveWorkbook.Names("User_Dol").value
'        .Range("A9") = ActiveWorkbook.Names("UFK_CODE").Value
'        .Range("A10") = ActiveWorkbook.Names("OUT_FOOTER").Value

        .Range("A1") = .Range("A1").value
        .Range("A2") = .Range("A2").value
        .Range("A3") = .Range("A3").value
        .Range("A4") = .Range("A4").value
        .Range("A5") = .Range("A5").value
        .Range("A6") = .Range("A6").value
        .Range("A7") = .Range("A7").value
        .Range("A8") = .Range("A8").value
'        .Range("A9") = .Range("A9").Value
'        .Range("A10") = .Range("A10").Value

        ' проверим код территории
        If exists_name("notd") Then
            For i = Sheets("Данные").Range("DataFields").column To Sheets("Данные").Range("DataFields").column + Sheets("Данные").Range("DataFields").Columns.count - 1
                If Sheets("Данные").Cells(Sheets("Данные").Range("DataFields").row, i) = "notd" Then
                    .Range("A9").NumberFormat = "@"
                    .Range("A9") = VBA.Left(Sheets("Данные").Cells(Sheets("Данные").Range("DataFields").row + 1, i), 2)
                    Exit For
                End If
            Next
        End If
    End With

    Set ToolbarAction = CommandBars.Add(Name:="Меню OUT", Position:=msoBarTop, Temporary:=True)
    With ToolbarAction.Controls.Add(Type:=msoControlButton)
        .FaceId = 565
        .Style = msoButtonIcon
        .Caption = "Сформировать текстовый файл"
        .OnAction = s
        .Visible = True
        .Enabled = True
    End With

    ToolbarAction.Enabled = True
    ToolbarAction.Visible = True

    init_data = 1
    Application.ThisWorkbook.VBProject.Name = Application.ThisWorkbook.VBProject.Name + "X"
    Application.ThisWorkbook.Saved = True
    Application.ActiveWorkbook.Saved = True
End Function

' вывод шапки
Function whiteHead() As Boolean
Dim fileName As String, i As Integer, j As Integer, tmpStr As String, lcDate As String
Dim sheetsService, lCell, wSheet
    whiteHead = False
    On Error GoTo doError
'    Set wSheet = Application.ActiveWorkbook.ActiveSheet
    Set sheetsService = Application.ActiveWorkbook.Sheets("Service")
 '   Set lCell = StringFunc.LastCell(wSheet.Cells)
    On Error GoTo 0
    
    fileName = GetFileFromAPI("C:\", "txt")
    If fileName <> "" Then
        lcDate = VBA.Trim(sheetsService.Range("A1"))
        lcDate = VBA.Format(lcDate, "dd.mm.yy")

        Open fileName For Output As #1
        Print #1, convert_dos_win(sheetsService.Range("A3").Text, 1)
        Print #1, convert_dos_win("УК = " + sheetsService.Range("A9"), 1)
        Print #1, convert_dos_win("ДТ = " + lcDate, 1)
        whiteHead = True
    End If
   Exit Function
doError:
    Call MsgBox("Ошибка при инициализации данных. " + vbNewLine + "Возможно, этот отчет не поддерживает режим формирования выходного файла", vbCritical, "Ошибка !")
End Function

'вывод данных
Function writeData(razdelNum As Integer, sheetsName As String, firstRow As Integer, formatStr As String)
Dim formatArray() As Integer, ColCount As Integer, i As Integer, j As Integer, wrkSheet As Worksheet, row As Integer, сStr As String
    writeData = False
    
    On Error GoTo doError
    
    ColCount = chr_count(formatStr, "|") + 1
    ReDim formatArray(ColCount)
    For i = 1 To ColCount
        formatArray(i) = getNextSubstr(formatStr, "|")
    Next

    Set wrkSheet = Sheets(sheetsName)
    
    row = firstRow
    
    If wrkSheet.Cells(row, 1).Locked Then Exit Function
    Print #1, ""
    Print #1, convert_dos_win("РД = " + VBA.Trim(VBA.str(razdelNum)), 1)
    Print #1, ""
    While Not wrkSheet.Cells(row, 1).Locked
        сStr = ""
        For j = 1 To ColCount
          If formatArray(j) >= 0 Then
            If formatArray(j) <> 0 Then 'текстовое поле
                сStr = сStr + IIf(сStr = "", "", "|") + VBA.Left(wrkSheet.Cells(row, j).Text + Space(formatArray(j)), formatArray(j))
            Else
                сStr = сStr + IIf(сStr = "", "", "|") + num_To_Str(wrkSheet.Cells(row, j).value, 16)
            End If
          End If
        Next
        Print #1, convert_dos_win(сStr, 1)
        row = row + 1
    Wend
    
    сStr = ""
    For j = 1 To ColCount
      If formatArray(j) >= 0 Then
        If formatArray(j) <> 0 Then 'текстовое поле
            сStr = сStr + IIf(сStr = "", "", "|")
            For i = 1 To formatArray(j)
                сStr = сStr + "9"
            Next
        Else
            сStr = сStr + IIf(сStr = "", "", "|") + num_To_Str(wrkSheet.Cells(row, j).value, 16)
        End If
      End If
    Next
    Print #1, convert_dos_win(сStr, 1)
    writeData = True
    
   Exit Function
doError:
    Call MsgBox("Ошибка при выгрузке раздела " + str(razdelNum), vbCritical, "Ошибка !")

End Function

Function writeFooter() As Boolean
    Print #1, ""
    Print #1, "#"
    Close #1
    Call MsgBox("Файл успешно сформирован", vbInformation)
End Function

Sub FormTxtF603()
Dim fileName As String, i As Integer, j As Integer, tmpStr As String, lcDate As String
    If whiteHead Then
        Call writeData(1, "Расход (1)", 12, "3|4|3|3|6|0|0|0|0|0|0")
        Call writeData(5, "Аренда (1)", 7, "3|4|3|3|6|0")
        Call writeFooter
    End If
End Sub

Sub FormTxtF605()
Dim fileName As String, i As Integer, j As Integer, tmpStr As String, lcDate As String
    If whiteHead Then
        Call writeData(1, "Раздел 1 (1)", 11, "-1|3|7|0|0|0|0|0|0|0|0")
        Call writeData(2, "Раздел 2 (1)", 4, "-1|3|0|0|0|0|0")
        Call writeFooter
    End If
End Sub

Sub FormTxtF615()
Dim fileName As String, i As Integer, j As Integer, tmpStr As String, lcDate As String
    If whiteHead Then
        Call writeData(1, "Документ (1)", 12, "3|4|3|3|6|0|0|0|0")
        Call writeFooter
    End If
End Sub

Sub FormTxtF403()
Dim fileName As String, i As Integer, j As Integer, tmpStr As String, lcDate As String
    If whiteHead Then
        Call writeData(1, "Раздел 1 (1)", 14, "3|4|3|3|6|0|0|0|0")
        Call writeData(2, "Раздел 2 (1)", 7, "3|4|3|3|6|0|2")
        Call writeData(3, "Раздел 3 (1)", 7, "3|4|3|3|6|0|2")
        Call writeFooter
    End If
End Sub

Sub FormTxtF415()
Dim fileName As String, i As Integer, j As Integer, tmpStr As String, lcDate As String
    If whiteHead Then
        Call writeData(1, "Документ (1)", 14, "3|4|3|3|6|0|0")
        Call writeFooter
    End If
End Sub
