[/src]Option Explicit

Public cnn As New ADODB.Connection

Public Function OpenConection() As Integer
On Error GoTo err_
    OpenConection = - 1 
    
    If cnn.State <>  0  Then cnn.Close
    
    cnn.Open ("Provider=MSDASQL.1;Persist Security Info=False;Data Source=base")
    cnn.CommandTimeout =  100000 
    OpenConection =  0 
    
    Exit Function
err_:
    MsgBox "Íå ìîãó ïðèñîåäèíèòüñÿ ê ñåðâåðó!" & err.Description
End Function

Public Sub CloseConection()
    If cnn.State <>  0  Then cnn.Close
    Set cnn = Nothing
End Sub

Public Sub Make_TAA_Activity()
On Error GoTo error1

Dim query As String, nameProc As String, sheet As Worksheet, rs As ADODB.Recordset, sheetRep As Worksheet, i As Integer
Set sheetRep = Sheets("Ðåçóëüòàò")
i =  4 

nameProc = "rpt_TAA_Activity"
If OpenConection <  0  Then Exit Sub

If UserForm.Is_OK Then
    cnn.Execute "set dateformat dmy"
    query = "exec dbo." & nameProc & " '" & _
            CStr(UserForm.dtDateFrom.Value) & "', '" & _
            CStr(UserForm.dtDateTo.Value) & "', 0, 0"
    
    Set rs = New ADODB.Recordset
    Call rs.Open(query, cnn, ADODB.adOpenForwardOnly, ADODB.adLockReadOnly)
    
    If rs.EOF Then
        MsgBox "Íåò äàííûõ!", vbCritical
        Set rs = Nothing
        CloseConection
        Exit Sub
    End If
    rs.MoveFirst
    
'   Depo     Name    Week_num    workdays    Business    TT_Plan TT_fact
'   TT_PercVisit    TT_Active   TT_PercActive   VST_Plan    VST_Fact
'   VST_Active  VST_PercEffect  SellMoney   SellCount


    sheetRep.Activate
    Do While Not rs.EOF
        sheetRep.Cells(i,  1 ).Value = rs!Depo
        sheetRep.Cells(i,  2 ).Value = rs!SAS
        sheetRep.Cells(i,  3 ).Value = rs!Name
        sheetRep.Cells(i,  4 ).Value = rs!Week_num
        sheetRep.Cells(i,  5 ).Value = rs!workdays
        sheetRep.Cells(i,  6 ).Value = rs!business
        sheetRep.Cells(i,  7 ).Value = rs!TT_Plan
        sheetRep.Cells(i,  8 ).Value = rs!TT_fact
        sheetRep.Cells(i,  9 ).Value = rs!TT_PercVisit
        sheetRep.Cells(i,  10 ).Value = rs!TT_Active
        sheetRep.Cells(i,  11 ).Value = rs!TT_PercActive
        sheetRep.Cells(i,  12 ).Value = rs!VST_Plan
        sheetRep.Cells(i,  13 ).Value = rs!VST_Fact
        sheetRep.Cells(i,  14 ).Value = rs!VST_Active
        sheetRep.Cells(i,  15 ).Value = rs!VST_PercEffect
        sheetRep.Cells(i,  16 ).Value = rs!SellMoney
        sheetRep.Cells(i,  17 ).Value = rs!SellCount
        If rs!business = "Èòîãî" Then
            sheetRep.Rows(i).Font.Bold = True
        Else
            sheetRep.Rows(i).Font.Bold = False
        End If
        
       
        rs.MoveNext
        i = i +  1 
    Loop
    sheetRep.Cells( 1 ,  1 ).Select
    rs.Close
    Set rs = Nothing
    Exit Sub
    
End If

error1:
    Set rs = Nothing
    MsgBox "Îøèáêà! Îáðàòèòåñü ê ðàçðàáîò÷èêàì! " & err.Description, vbCritical
End Sub