Attribute VB_Name = "mdc_bas"
Option Explicit
Public pbFormCancel As Boolean, pnwrkODBC, pnLogin, pnParol, pnwrkConnect, pnODBC, pndbNameSql
Public docArr() As String, itogArr() As Integer

Sub initSeekPop()
    With SEEK_POP
        load SEEK_POP
        .lbMulti = lbMulti
        .lnWhatLoad = 1
        .Form_Init_New "v_0521312.xlt", "Расход"
        .Show
        Debug.Print SEEK_POP.pcRetValue
        Unload SEEK_POP
    End With
End Sub

Sub initMDK()
    MDK.codeDoc = "v_0521312"
    load MDK
    MDK.Show
    Unload MDK
End Sub


Sub initVars()
With Sheets("Service")
    pnODBC = VBA.Trim(.Range("A3").Value)  'DAtaSource
    pnLogin = VBA.Trim(.Range("A5").Value) 'Login
    pnParol = VBA.Trim(.Range("A6").Value) 'Parol
    pndbNameSql = VBA.Trim(.Range("A4").Value) 'Name DB SQL
'    dbUseODBC = pnODBC
End With
Call Server_Connect
End Sub

Sub load_data_1()
Dim lnColumn As Integer, lnRow As Integer, i As Integer, SqlStr As String
Dim lnDocColumn As Integer, lnDocRow As Integer
Dim row, col, wrkResultSet, doc As String
'stop
With Sheets("Service")
    lnDocColumn = .Range("TAB_DOC").column
    lnDocRow = .Range("TAB_DOC").row + 1
    ReDim docArr(.Range("A13"))
    ReDim itogArr(.Range("A13"))
    'инициализация массива кодов документов
    For i = lnDocRow To lnDocRow + .Range("A13") - 1
        docArr(i - lnDocRow + 1) = .Cells(i, lnDocColumn + 1)
        itogArr(i - lnDocRow + 1) = .Cells(i, lnDocColumn + 3)
    Next
    lnColumn = .Range("TAB_FORM").column
    lnRow = .Range("TAB_FORM").row + 1
    While .Cells(lnRow, lnColumn) <> ""
        row = .Cells(lnRow, lnColumn) - .Range("A10") + 1
        col = .Cells(lnRow, lnColumn + 1) - .Range("A11") + 1
        If itogArr(col) = 0 Then
            SqlStr = "SELECT COUNT(*) AS C FROM REPORTS R WHERE R.OBJECT = (SELECT LINK FROM S_OBJECTS WHERE CODE = ''" + docArr(col) + "'')" + _
                    " AND R.CORR_IN = " + VBA.str(.Range("A2")) + _
                    " AND R.DATE_BEGIN = ''" + VBA.Trim(.Range("A7")) + "''" + _
                    " AND R.DATE_END = ''" + VBA.Trim(.Range("A8")) + "''"
            Set wrkResultSet = pnwrkConnect.OpenRecordset("EXECUTE A_EXEC '" + SqlStr + "'", dbOpenDynaset)
            If wrkResultSet.Fields("C").Value > 0 Then
                SqlStr = "SELECT VALUE FROM REPORT_VALUES RV, REPORTS R WHERE R.LINK=RV.LINK_UP AND R.OBJECT = (SELECT LINK FROM S_OBJECTS WHERE CODE = ''" + docArr(col) + "'')" + _
                        " AND R.CORR_IN = " + VBA.str(.Range("A2")) + _
                        " AND R.DATE_BEGIN = ''" + VBA.Trim(.Range("A7")) + "''" + _
                        " AND R.DATE_END = ''" + VBA.Trim(.Range("A8")) + "''" + _
                        " AND RV.OBJECT = " + VBA.str(.Cells(lnRow, lnColumn + 2)) + _
                        " AND RV.BARS = " + VBA.str(.Cells(lnRow, lnColumn + 4)) + _
                        " AND RV.GRAFS = " + VBA.str(.Cells(lnRow, lnColumn + 3))
                Set wrkResultSet = pnwrkConnect.OpenRecordset("EXECUTE A_EXEC '" + SqlStr + "'", dbOpenDynaset)
                If Not wrkResultSet.EOF Then
                    Sheets("603+615").Cells(.Cells(lnRow, lnColumn), .Cells(lnRow, lnColumn + 1)) = wrkResultSet.Fields("VALUE").Value
                Else
                    Sheets("603+615").Cells(.Cells(lnRow, lnColumn), .Cells(lnRow, lnColumn + 1)) = 0
                End If
            Else
                    Sheets("603+615").Cells(.Cells(lnRow, lnColumn), .Cells(lnRow, lnColumn + 1)) = "" '"Нет данных"
            End If
            'Debug.Print wrkResultSet.Fields("VALUE").Value
        Else
            doc = Replace_in_Str(docArr(col), ",", "''''")
            doc = Replace_in_Str(doc, "''''", "'',''")
            SqlStr = "SELECT COUNT(*) AS C FROM REPORTS R WHERE R.OBJECT in (SELECT LINK FROM S_OBJECTS WHERE CODE in (''" + doc + "''))" + _
                    " AND R.CORR_IN = " + VBA.str(.Range("A2")) + _
                    " AND R.DATE_BEGIN = ''" + VBA.Trim(.Range("A7")) + "''" + _
                    " AND R.DATE_END = ''" + VBA.Trim(.Range("A8")) + "''"
            Set wrkResultSet = pnwrkConnect.OpenRecordset("EXECUTE A_EXEC '" + SqlStr + "'", dbOpenDynaset)
            If wrkResultSet.Fields("C").Value > 0 Then
                SqlStr = "SELECT case when sum(SUMMA) is null then 0 else sum(SUMMA) end AS VALUE FROM REPORT_ADD_FIELDS RAF, REPORTS R, REPORT_SVOD_DATA RSD WHERE R.LINK=RAF.LINK_UP AND R.OBJECT IN (SELECT LINK FROM S_OBJECTS WHERE CODE in (''" + doc + "''))" + _
                        " AND R.CORR_IN = " + VBA.str(.Range("A2")) + _
                        " AND R.DATE_BEGIN = ''" + VBA.Trim(.Range("A7")) + "''" + _
                        " AND R.DATE_END = ''" + VBA.Trim(.Range("A8")) + "''" + _
                        " AND RAF.LINK = RSD.LINK_UP AND Razdel = " + VBA.str(.Cells(lnRow, lnColumn + 2)) + _
                        " AND GRAFA = " + VBA.str(.Cells(lnRow, lnColumn + 3)) + _
                        IIf(.Cells(lnRow, lnColumn + 5) = "", "", " AND " + .Cells(lnRow, lnColumn + 5))
                Set wrkResultSet = pnwrkConnect.OpenRecordset("EXECUTE A_EXEC '" + SqlStr + "'", dbOpenDynaset)
                If Not wrkResultSet.EOF Then
                    Sheets("603+615").Cells(.Cells(lnRow, lnColumn), .Cells(lnRow, lnColumn + 1)) = wrkResultSet.Fields("VALUE").Value
                Else
                    Sheets("603+615").Cells(.Cells(lnRow, lnColumn), .Cells(lnRow, lnColumn + 1)) = 0
                End If
            Else
                    Sheets("603+615").Cells(.Cells(lnRow, lnColumn), .Cells(lnRow, lnColumn + 1)) = "" '"Нет данных"
            End If
        End If
        lnRow = lnRow + 1
    Wend
    Call load_by_bk
End With
End Sub

Sub load_by_bk()
Dim lnColumn As Integer, lnRow As Integer, i As Integer, SqlStr As String, wrkResultSet
With Sheets("603+615")
    lnColumn = .Range("FIRST_BK_1").column
    lnRow = .Range("FIRST_BK_1").row
    
    SqlStr = "EXECUTE V_MDC_TABLE " + _
            " '" + VBA.Trim(Sheets("Service").Range("A7")) + "'," + _
            " '" + VBA.Trim(Sheets("Service").Range("A8")) + "'," + _
            VBA.str(Sheets("Service").Range("A2")) + IIf(Sheets("Service").Range("A21").Text <> "", ",1", ",0")
    Set wrkResultSet = pnwrkConnect.OpenRecordset(SqlStr, dbOpenDynaset)
    While Not wrkResultSet.EOF
        If Val(wrkResultSet.Fields("VALUE1").Value) <> 0 Or Val(wrkResultSet.Fields("VALUE2").Value) <> 0 Then
            .Rows(lnRow).Insert
            .Rows(lnRow).AutoFit
            .Cells(lnRow, Sheets("Service").Range("A11") + Sheets("Service").Range("A13")).FormulaR1C1Local = .Cells(lnRow - 1, Sheets("Service").Range("A11") + Sheets("Service").Range("A13")).FormulaR1C1Local
            .Cells(lnRow, lnColumn) = wrkResultSet.Fields("DEP").Value + ", " + wrkResultSet.Fields("DIV").Value + ", " + wrkResultSet.Fields("TGT").Value + ", " + wrkResultSet.Fields("EXP").Value + ", " + wrkResultSet.Fields("ITEM").Value
            .Cells(lnRow, lnColumn + 3) = wrkResultSet.Fields("VALUE1").Value
            .Cells(lnRow, lnColumn + 4) = wrkResultSet.Fields("VALUE2").Value
            lnRow = lnRow + 1
        End If
        wrkResultSet.MoveNext
    Wend
    .Rows(lnRow).RowHeight = 1
End With
End Sub

'Главная процедура
Public Sub load_data()
Dim cRow As Integer, cCol As Integer, cColCnt As Integer, i As Integer
Dim wSheet As Worksheet, sheetsService As Worksheet, procName As String, pageName As String
Dim wrkResultSet, SqlStr As String

    Call initVars
    Call Server_Connect
    Set sheetsService = Sheets("Service")

' заполним поле Корреспондент (CORR)
    SqlStr = "SELECT [NAME]=SNAME FROM S_CORR WHERE LINK = " + VBA.str(sheetsService.Range("A2").Value)
    Set wrkResultSet = pnwrkConnect.OpenRecordset(SqlStr, dbOpenDynaset)

    ActiveSheet.Range("CORR") = ActiveSheet.Range("CORR").Text + wrkResultSet.Fields("NAME").Value

    Set wrkResultSet = Nothing
    
    Set sheetsService = Sheets("Service")
    cRow = sheetsService.Range("KRIT_CONT").row
    cCol = sheetsService.Range("KRIT_CONT").column
    cColCnt = sheetsService.Range("KRIT_CONT").Columns.count
    
    Set wSheet = ActiveSheet
    With sheetsService
        .Range(.Cells(cRow + 1, cCol), .Cells(cRow + 1, cCol + cColCnt - 1)) = ""
    End With
    
    For i = 1 To sheetsService.Range("A20")
        sheetsService.Cells(cRow + 1, cCol) = i
        sheetsService.Cells(cRow + 3, cCol).CALCULATE
        sheetsService.Cells(cRow + 4, cCol).CALCULATE
        procName = sheetsService.Cells(cRow + 4, cCol).Text
        pageName = sheetsService.Cells(cRow + 3, cCol).Text
        Sheets(pageName).Activate
        If VBA.Trim(procName) <> "" Then
            Call Application.Run(procName)
        End If
    Next
    wSheet.Activate
End Sub

Sub load_data_2()
Dim lnColumn As Integer, lnRow As Integer, i As Integer, SqlStr As String, wrkResultSet
Dim flag As Boolean

flag = True
With Sheets("600+603")
    lnColumn = .Range("FIRST_BK_2").column
    lnRow = .Range("FIRST_BK_2").row
    'stop
    SqlStr = "EXECUTE V_MDC_TABLE_603_600 " + _
            " '" + VBA.Trim(Sheets("Service").Range("A7")) + "'," + _
            " '" + VBA.Trim(Sheets("Service").Range("A8")) + "'," + _
            VBA.str(Sheets("Service").Range("A2")) + IIf(Sheets("Service").Range("A21").Text <> "", ",1", ",0")
    Set wrkResultSet = pnwrkConnect.OpenRecordset(SqlStr, dbOpenDynaset)
    While Not wrkResultSet.EOF
        If Val(wrkResultSet.Fields("VALUE1").Value) <> 0 Or Val(wrkResultSet.Fields("VALUE2").Value) <> 0 Then
            '.Cells(lnRow, Sheets("Service").Range("A11") + Sheets("Service").Range("A13")).FormulaR1C1Local = .Cells(lnRow - 1, Sheets("Service").Range("A11") + Sheets("Service").Range("A13")).FormulaR1C1Local
            If flag And wrkResultSet.Fields("STATUS").Value = 1 Then
                flag = False
                lnColumn = .Range("FIRST_BK_21").column
                lnRow = .Range("FIRST_BK_21").row
            End If
            .Rows(lnRow).Insert
            .Rows(lnRow).AutoFit
            .Cells(lnRow, lnColumn) = wrkResultSet.Fields("cDIV").Value + ", " + wrkResultSet.Fields("cTGT").Value + ", " + wrkResultSet.Fields("cEXP").Value
            .Cells(lnRow, lnColumn + 1) = wrkResultSet.Fields("VALUE1").Value
            .Cells(lnRow, lnColumn + 2) = wrkResultSet.Fields("VALUE2").Value
            .Cells(lnRow, lnColumn + 3) = VBA.Val(wrkResultSet.Fields("VALUE1").Value) - VBA.Val(wrkResultSet.Fields("VALUE2").Value)
            lnRow = lnRow + 1
        End If
        wrkResultSet.MoveNext
    Wend
    .Rows(lnRow).RowHeight = 1
End With
End Sub


Sub load_data_3()
Dim lnColumn As Integer, lnRow As Integer, i As Integer, SqlStr As String, wrkResultSet
Dim flag As Boolean

flag = True
With Sheets("703+713")
    lnColumn = .Range("FIRST_BK_3").column
    lnRow = .Range("FIRST_BK_3").row
    SqlStr = "EXECUTE V_MDC_TABLE " + _
            " '" + VBA.Trim(Sheets("Service").Range("A7")) + "'," + _
            " '" + VBA.Trim(Sheets("Service").Range("A8")) + "'," + _
            VBA.str(Sheets("Service").Range("A2")) + ", " + IIf(Sheets("Service").Range("A21").Text <> "", "1", "0") + ", 1"
    Set wrkResultSet = pnwrkConnect.OpenRecordset(SqlStr, dbOpenDynaset)
    While Not wrkResultSet.EOF
'        If Val(wrkResultSet.Fields("VALUE1").Value) <> 0 Or Val(wrkResultSet.Fields("VALUE2").Value) <> 0 Then
            '.Cells(lnRow, Sheets("Service").Range("A11") + Sheets("Service").Range("A13")).FormulaR1C1Local = .Cells(lnRow - 1, Sheets("Service").Range("A11") + Sheets("Service").Range("A13")).FormulaR1C1Local
            .Rows(lnRow).Insert
            .Rows(lnRow).AutoFit
            .Cells(lnRow, lnColumn) = wrkResultSet.Fields("DEP").Value + ", " + wrkResultSet.Fields("DIV").Value + ", " + wrkResultSet.Fields("TGT").Value + ", " + wrkResultSet.Fields("EXP").Value + ", " + wrkResultSet.Fields("ITEM").Value
            For i = 1 To 9
                .Cells(lnRow, lnColumn + i + 9) = wrkResultSet.Fields("VALUE" + VBA.Trim(VBA.str(i))).Value
                .Cells(lnRow, lnColumn + i + 18) = wrkResultSet.Fields("VALUE2" + VBA.Trim(VBA.str(i))).Value
                .Cells(lnRow, lnColumn + i) = VBA.Val(wrkResultSet.Fields("VALUE" + VBA.Trim(VBA.str(i))).Value) - VBA.Val(wrkResultSet.Fields("VALUE2" + VBA.Trim(VBA.str(i))).Value)
            Next
            lnRow = lnRow + 1
 '       End If
            wrkResultSet.MoveNext
    Wend
    .Rows(lnRow).RowHeight = 1
End With
End Sub


Sub load_data_4()
Dim lnColumnCount As Integer, lnColumn As Integer, lnRow As Integer, lnRowCount As Integer, i As Integer, j As Integer, SqlStr As String, wrkResultSet
Dim flag As Boolean, tempStr As String, baseStr As String, Value() As Double
Dim znak As String, evalStr As String
'Stop
flag = True

With Sheets("600+603(итоги)")
    lnColumn = .Range("DATA_x").column
    lnColumnCount = .Range("DATA_x").Columns.count
    ReDim Value(lnColumnCount)
    
    lnRow = .Range("DATA_x").row
    lnRowCount = .Range("DATA_x").Rows.count
    For i = lnRow To lnRow + lnRowCount - 1
        For j = lnColumn To lnColumn + lnColumnCount - 1
            baseStr = .Cells(i, j).Text
            evalStr = ""
            While VBA.Trim(baseStr) <> ""
                znak = ""
                tempStr = getPart(baseStr, znak)
                evalStr = evalStr + VBA.str(calcPart(tempStr)) + znak
            Wend
            .Cells(i, j) = Application.Evaluate(evalStr)
            .Cells(i, j).AddComment (evalStr)
        Next
    Next
End With
End Sub

Function calcPart(calcStr As String) As Double
Dim tempStr As String, doc As String, SqlStr As String, mode As Integer, res As Double, wrkResultSet
    calcStr = Replace_in_Str(calcStr, "(", "")
    calcStr = Replace_in_Str(calcStr, ")", "")
    tempStr = VBA.Trim(getNextSubstr(calcStr, ","))
    doc = IIf(Sheets("Service").Range("A21") = "", "'DOCUMENTS_", "'DOCUMENTS_SVOD_")
        
    If tempStr = "'603'" Or tempStr = "'703'" Or tempStr = "'615'" Or tempStr = "'715'" Then
        SqlStr = doc + "F" + VBA.Mid(tempStr, 2)
        SqlStr = SqlStr + ", '', " + getNextSubstr(calcStr, ",") + ", " + getNextSubstr(calcStr, ",")
        mode = 1
    End If
    
    If tempStr = "'600'" Then
        mode = 0
        SqlStr = doc + "0521312'"
        SqlStr = SqlStr + ", " + getNextSubstr(calcStr, ",")
        If calcStr <> "" Then
            SqlStr = SqlStr + ", " + getNextSubstr(calcStr, ",") + ", 2"
        Else
            SqlStr = SqlStr + ", 1, 2"
        End If
    End If
        
    SqlStr = "EXECUTE V_SELECT_REPORTS " + SqlStr + ", " + VBA.str(Sheets("Service").Range("A2")) + ", '" + VBA.Trim(Sheets("Service").Range("A7")) + "', '" + VBA.Trim(Sheets("Service").Range("A8")) + "'," + VBA.str(mode)
    
    Set wrkResultSet = pnwrkConnect.OpenRecordset(SqlStr, dbOpenDynaset)
    If IsNull(wrkResultSet.Fields("RESULT").Value) Then
        res = 0
    Else
        res = wrkResultSet.Fields("RESULT").Value
    End If
    Set wrkResultSet = Nothing
    calcPart = res

'        If tempStr = "'612'" Then
'            mode = 0
'            sqlStr = doc + "F612'"
'            sqlStr = sqlStr + ", " + getNextSubstr(calcStr, ",")
'
'        End
        
End Function

Function getPart(bStr As String, znak As String) As String
Dim flag As Boolean, i As Integer, ch As String
    
    flag = False
    i = 1
    ch = ""
    While Not flag And i <= VBA.Len(bStr)
        ch = VBA.Mid(bStr, i, 1)
        If ch = "+" Or ch = "-" Or ch = "*" Or ch = "/" Then
            flag = True
        Else
            i = i + 1
        End If
    Wend
    getPart = VBA.Left(bStr, i - 1)
    If flag Then znak = ch Else znak = ""
    If VBA.Len(bStr) > i Then
        bStr = VBA.Trim(VBA.Mid(bStr, i + 1))
    Else
        bStr = ""
    End If
End Function

