Dim CrApp1 As New CRAXDDRT.Application
Dim CrRep As CRAXDDRT.Report
--------

 CrRep.PrintOut  

Открытие отчета для проверки в модуле формы  --- 8312
Выполнение запроса --- 8328
Присвоение готового рекордсета в модуле создания отчета --- 0
Показ  отчета в модуле создания отчета --- 14156
Открытие отчета --- 14156


Открытие отчета для проверки в модуле формы  --- 7360
Выполнение запроса --- 7360
Присвоение готового рекордсета в модуле создания отчета --- 0
Показ  отчета в модуле создания отчета --- 4110
Открытие отчета --- 4110


Открытие отчета для проверки в модуле формы  --- 7484
Выполнение запроса --- 7500
Присвоение готового рекордсета в модуле создания отчета --- 0
Показ  отчета в модуле создания отчета --- 4344
Открытие отчета --- 4344

Public Sub ReportOpenQRY(nTypeRep As TypeRep, _
                        nId As Long, _
                        cFile As String, _
                        cSql As String, _
                        cName As String, _
                        Optional lView As Boolean = True, _
                        Optional nExport As Long =  0 , _
                        Optional lNoSelect As Boolean = False, _
                        Optional rsRep As ADODB.Recordset, _
                        Optional oRient As Integer =  1 )
 Dim rs As New ADODB.Recordset
   Dim con As ADODB.Connection
   Dim com As New ADODB.Command
   Dim lListRep As Boolean
   Dim f As Form_frmRepList
   Set con = CurrentProject.Connection
 
   
   
  
   Set rs = rsRep
       
   If rs.State = adStateClosed Then
        com.CommandText = cSql
        com.CommandType = adCmdTable
        Set com.ActiveConnection = con
        com.Parameters( 0 ).value = nId
        Set rsRep = New ADODB.Recordset
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Замер скорости выполнения 
    fncTimeWork
        rs.Open com, , adOpenKeyset, adLockReadOnly
    Debug.Print "Выплнение запроса в модуле создания отчета --- " & fncTimeWork(True)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   Else
       rs.MoveFirst
   End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''Замер скорости выполнения 
        fncTimeWork
            ReportView nId, cFile, "", cName, rs, lView, nExport, oRient
        Debug.Print "Показ  отчета в модуле создания отчета --- " & fncTimeWork(True)
       

   Set rs = Nothing
   Set f = Nothing
End Sub


Public Sub ReportView(nId As Long, _
                        cNameRpt As String, _
                        cSql As String, _
                        cCaption As String, _
                        Optional rs As ADODB.Recordset = Nothing, _
                        Optional lView As Boolean = True, _
                        Optional nExport As Long =  0 , _
                        Optional oRient As Integer =  1 )
Dim CrApp1 As New CRAXDDRT.Application
Dim CrRep As CRAXDDRT.Report
Dim CrDB As CRAXDDRT.Database
Dim CrTables As CRAXDDRT.DatabaseTables
Dim CrTable As CRAXDDRT.DatabaseTable
Dim rsData As New ADODB.Recordset
Dim viewreport1 As CrystalActiveXReportViewer
Dim frmReport As New Form_frmCrystalReport
Dim cSavePath As String

Static nReportCount As Long


cSavePath = SavePath()

'If ReportCheck(cNameRpt) Then
'   afrmReport.Item(cNameRpt).SetFocus
'  Exit Sub
'End If

'check existence file report
If Not FileExists(ReportDir & cNameRpt & ".rpt") Then
    MsgBox "Не найден файл отчета <" & cNameRpt & ".rpt>!", , "Ошибка открытия отчета"
    Exit Sub
End If


nReportCount = nReportCount + 1
'open report
Set CrRep = CrApp1.OpenReport(ReportDir & cNameRpt & ".rpt")
'set the database object to the reports database
Set CrDB = CrRep.Database
'Set the databasetables object
Set CrTables = CrDB.tables

'set the databasetable object to the first table in the report
Set CrTable = CrTables(1)

Set rsData = rs
If rsData.State = adStateClosed Then
  rsData.Open cSql, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
End If
'sets ADO recordset as the data for the first table
CrTable.SetPrivateData  3 , rsData




    CrRep.PaperOrientation = oRient ' устанавливаем ориентацию страницы

    If lView Then
        frmReport.Tag = cNameRpt
        frmReport.CAPTION = nReportCount & " : " & cCaption
        frmReport.CrystalActiveXReportViewer0.ReportSource = CrRep
        frmReport.CrystalActiveXReportViewer0.ViewReport
        frmReport.Visible = True
        frmReport.SetFocus
        afrmReport.Add frmReport, frmReport.Tag
        
    Else
       
        CrRep.PrintOut , 1
    
    End If

    Set CrRep = Nothing
    Set CrTable = Nothing
    Set CrTables = Nothing
    Set CrDB = Nothing
    Set CrApp1 = Nothing
    If rsData.State = adStateOpen Then rsData.Close
    Set rsData = Nothing
    'Set frmReport = Nothing
 
End Sub

Private Declare Function a2ku_apigettime Lib "winmm.dll" Alias "timeGetTime" () As Long


Public Function fncTimeWork(Optional blnStopTime As Boolean =  0 ) As Long
    'blnStopTime - флаг окончания отсчета времени
    
    Static lngTimeStarting As Long
    
    If Not blnStopTime Then
        'задаем точку отсчета
        lngTimeStarting = a2ku_apigettime()
        fncTimeWork = lngTimeStarting
    Else
        'получаем суммарное время
        fncTimeWork = a2ku_apigettime() - lngTimeStarting
    End If
End Function 'fncTimeWork