Excel выводит отчеты СЛИШКОМ долго!

[Normann]

Очень долго, просто супердолго, что с этим можно сделать?

 

[European]

Слишком долгий процесс инициализации или записи?

 

[Normann]

Окно естественно скрыто до полного формирования, но что при видимом что при невидимом окне - все едино, а конкретно тормозит он на заполнении ячеек.

Вот пример на всякий случай:

Dim RSet1 As ADODB.Recordset
Dim xlsApp As Excel.Application

Dim nNum As Integer
Dim nNum2 As Integer

Dim strSumFormula As String

Set RSet1 = New ADODB.Recordset
RSet1.Open " SELECT СПР_ФАМИЛИЙ.НОМЕР, СПР_ФАМИЛИЙ.ФАМИЛИЯ, СПР_ФАМИЛИЙ.ИМЯ," & _
" Банк.тарифы, Банк.Договор, Банк.[Дни посещения]," & _
" IIf([Банк].[входящее сальдо]<0,[Банк].[входящее сальдо],0)," & _
" IIf([Банк].[входящее сальдо]>0,[Банк].[входящее сальдо],0)," & _
" Банк.Уплачено, Банк.Начислено, Банк.возврат," & _
" IIf([Банк].[Конечное сальдо]<0,[Банк].[Конечное сальдо],0)," & _
" IIf([Банк].[Конечное сальдо]>0,[Банк].[Конечное сальдо],0)" & _
" FROM [период глобал] INNER JOIN (СПР_ФАМИЛИЙ INNER JOIN Банк" & _
" ON СПР_ФАМИЛИЙ.НОМЕР = Банк.Ребенок)" & _
" ON ([период глобал].[год расчета] = Банк.[год расчета])" & _
" AND ([период глобал].[месяц расчета] = Банк.[Месяц расчета])" & _
" WHERE (((СПР_ФАМИЛИЙ.ГРУППА)=" & strGroup & ")" & _
" AND ((СПР_ФАМИЛИЙ.[№ САДА])=" & strKindergarden & "))" & _
" ORDER BY СПР_ФАМИЛИЙ.ФАМИЛИЯ", MainConnection, adOpenForwardOnly, adLockReadOnly

If RSet1.EOF Then
MsgBox "В указанном Вами саду под номером " & strKindergarden & _
" нет указанной вами группы " & strGroup & "!", vbCritical, "Ошибка"
GoTo Clearing
End If
DoEvents
Debug.Print "Querry is right"

Set xlsApp = New Excel.Application
DoEvents
Debug.Print "Excel application is created"
With xlsApp
.Workbooks.Add App.Path & "\Reports\R3.xls"
.Cells(1, 6) = strKindergarden
.Cells(3, 1) = "Группа " & strGroup
.Cells(3, 5) = nrmGetStrMonth(nCalculationMonth)
.Cells(3, 9) = cKolDney
Debug.Print "Hat has been filled"
nNum = 7
While Not RSet1.EOF
.Range("A" & nNum, "M" & nNum).Borders.LineStyle = xlContinuous
Debug.Print "Borders has been painted"
.Cells(nNum, 1) = RSet1.Fields(0).Value
.Cells(nNum, 2) = RSet1.Fields(1).Value
.Cells(nNum, 3) = RSet1.Fields(2).Value
.Cells(nNum, 4) = RSet1.Fields(3).Value
.Cells(nNum, 5) = RSet1.Fields(4).Value
.Cells(nNum, 6) = RSet1.Fields(5).Value
.Cells(nNum, 7) = RSet1.Fields(6).Value
.Cells(nNum, 8) = RSet1.Fields(7).Value
.Cells(nNum, 9) = RSet1.Fields(8).Value
.Cells(nNum, 10) = RSet1.Fields(9).Value
.Cells(nNum, 11) = RSet1.Fields(10).Value
.Cells(nNum, 12) = RSet1.Fields(11).Value
.Cells(nNum, 13) = RSet1.Fields(12).Value

Debug.Print nNum - 7 & " has been filled"
RSet1.MoveNext
Debug.Print "Next"
nNum = nNum + 1
Wend
.Range("A" & nNum, "B" & nNum).Merge
.Cells(nNum, 1) = "И ТОГО"
.Cells(nNum, 3).HorizontalAlignment = xlLeft
nNum2 = nNum - 7
.Cells(nNum, 3) = nNum2 & IIf(nNum2 > 4 And nNum2 < 2, " человек", " человека")
strSumFormula = "=SUM(R[-" & nNum2 & "]C:R[-1]C)"
.Cells(nNum, 5).FormulaR1C1 = strSumFormula
.Cells(nNum, 7).FormulaR1C1 = strSumFormula
.Cells(nNum, 9).FormulaR1C1 = strSumFormula
.Cells(nNum, 10).FormulaR1C1 = strSumFormula
.Cells(nNum, 11).FormulaR1C1 = strSumFormula
.Cells(nNum, 12).FormulaR1C1 = strSumFormula
.Cells(nNum, 13).FormulaR1C1 = strSumFormula
.Visible = True
End With
Set xlsApp = Nothing

 

[Normann]

Ура! Случайно заметил - когда стоит режим просмотра "разметка страницы" то он обрабатывает документ ооочень долго, а при обычном режиме в раз все делает . Вопрос закрыт.

 

[Tanya]

Хоть вопрос и закрыт, хотелось бы заметить (вдруг пригодится)
что! Процесс заполнения листа Excel будет происходить быстрее
если вставлять не по отдельным ячейкам, а массивом
то есть, сначала определить двумерный массив, а затем одной операцией разместить
данные массива на листе

Dim ArrVar as variant

...

ArrVar = RSet1.GetRows()

with xlsApp.ActiveWorkSheet
.Range(.Cells(nNum, 1), .Cells(nNum+ubound(arrVar), ubound(ArrVar, 2))) = ArrVar
End with

...

 

[Normann]

Спасибо, буду иметь в виду