Добрый день.
Просьба помочь, что не так.
Медленно выгружаются данные из грида в Excel.
Высылаю рабочий код.
[code]
LPARAMETERS loSource, lcCaption, lnModeView, laCaption
LOCAL loExcel, lcOldError, lсCaptionSheet, lnCount, lnRecno, lnDelta, ;
i, j, jj, lcAlias, lcRange, lValue, lcNameFile, F_PROG, lOlsSET_CENTURY, ;
loColumn, m.lcCommand, m.lcComment
EXTERNAL ARRAY laCaption
THISFORM.MYGrid1.MousePointer=11
LOCAL ARRAY laCount[1]
*-- Метод выводит в таблицу EXCEL данные из локального курсора или из GRID
m.lnModeView = IIF(VARTYPE(m.lnModeView) == "N", m.lnModeView, 0)
m.lnFlag = 0
m.lOlsSET_CENTURY = SET("CENTURY")
m.loSource=ThisForm.Mygrid1
DO CASE
CASE VARTYPE(m.loSource) == "O" AND UPPER(m.loSource.BaseClass) == "GRID" ;
AND !EMPTY(m.loSource.RecordSource) AND ;
USED(m.loSource.RecordSource) AND INLIST(m.loSource.RecordSourceType, 0, 1)
m.lnFlag = 1
m.lcAlias = loSource.RecordSource
CASE VARTYPE(m.loSource) == "C" AND USED(m.loSource)
m.lcAlias = m.loSource
m.lnFlag = 2
OTHERWISE
IF !EMPTY(ALIAS())
m.lcAlias = ALIAS()
m.lnFlag = 2
ENDIF
ENDCASE
IF m.lnFlag = 0
MESSAGEBOX("Не найден источник данных!", 16, "ОШИБКА ЭКСПОРТА В EXCEL")
RETURN .F.
ENDIF
m.lcCaption=""
m.lcNameFile = LEFT(CHRTRAN(CHRTRAN(m.lcCaption, "/:;*?!()[]", " "), ["], [ ]), 127)
m.lcNameFile = PUTFILE("Выбор файла для экспорта данных", GETENV('USERPROFILE') + "" + "Мои документы"+ "" + m.lcNameFile , "XLSX")
IF EMPTY(m.lcNameFile)
RETURN
ENDIF
WAIT WINDOW "Создание объекта класса EXCEL..." NOWAIT NOCLEAR AT SROWS()/2, SCOLS()/2
m.lcOldError = ON("ERROR")
ON Error m.loExcel = .NULL.
m.loExcel = GETOBJECT(m.lcNameFile, "Excel.Application")
IF ISNULL(m.loExcel)
m.loExcel = CREATEOBJECT("Excel.Application")
ENDIF
ON Error &lcOldError
IF ISNULL(m.loExcel)
WAIT CLEAR
MESSAGEBOX("Не могу открыть приложение EXCEL", 16, "ОШИБКА ЭКСПОРТА В EXCEL")
RETURN .F.
ENDIF
WAIT WINDOW "Формирую рабочий лист EXCEL..." NOWAIT NOCLEAR AT SROWS()/2, SCOLS()/2
WITH m.loExcel
.WorkBooks.Add
.DisplayAlerts = .F.
FOR m.i = 1 TO .Sheets.Count - 1
.Sheets(m.i).Delete
ENDFOR
.Sheets(1).Select
.Sheets(1).Name = "Лист1"
ENDWITH
SELECT (m.lcAlias)
IF m.lnFlag = 1
m.lnCount = m.loSource.ColumnCount
ELSE
m.lnCount = FCOUNT()
ENDIF
*-- Формируем заголовки столбцов
WAIT WINDOW "Формирую заголовки столбцов таблицы EXCEL..." NOWAIT NOCLEAR AT SROWS()/2, SCOLS()/2
m.ii = 0
m.lnDelta = 0
FOR m.i = 1 TO m.lnCount
WITH m.loExcel.Cells(1, 1)
.Value = "№ п/п"
.HorizontalAlignment = 3
.Orientation = 0
.WrapText = .F.
.ShrinkToFit = .F.
.MergeCells = .F.
WITH .Font
.Bold = .T.
.Size = 12
ENDWITH
ENDWITH
WITH m.loExcel.Cells(1, m.i + 1)
m.lcComment = ""
IF m.lnFlag <> 1
IF TYPE("laCaption[m.i]") == "C"
.Value = laCaption[m.i]
ELSE
.Value = FIELD(m.i)
ENDIF
ELSE
*-- Находим колонку с ColumnOrder = i
FOR m.j = 1 TO m.loSource.ColumnCount
IF TYPE("m.loSource.Columns(m.j).Header1") == "O"
IF m.i = m.loSource.Columns(m.j).ColumnOrder
* IF !EMPTY(m.loSource.Columns(m.j).Header1.ToolTipText)
* m.lcComment = m.loSource.Columns(m.j).Header1.ToolTipText
* ENDIF
.Value = m.loSource.Columns(m.j).Header1.Caption
EXIT
ENDIF
ENDIF
IF TYPE("m.loSource.Columns(m.i).SHeader1") == "O"
IF m.i = loSource.Columns(m.j).ColumnOrder
* IF !EMPTY(m.loSource.Columns(m.j).SHeader1.ToolTipText)
* m.lcComment = m.loSource.Columns(m.j).SHeader1.ToolTipText
* ENDIF
.Value = m.loSource.Columns(m.j).SHeader1.Caption
EXIT
ENDIF
ENDIF
ENDFOR
ENDIF
IF !EMPTY(m.lcComment)
.AddComment
.Comment.Visible = .F.
.Comment.Text(m.lcComment)
ENDIF
.HorizontalAlignment = 3
.Orientation = 0
.WrapText = .F.
.ShrinkToFit = .F.
.MergeCells = .F.
WITH .Font
.Bold = .T.
.Size = 12
ENDWITH
ENDWITH
ENDFOR
m.lnRecno = IIF(EOF(), 0, RECNO())
IF lnModeView > 0
* градусник
m.F_PROG = CreateObject( 'progess2' )
m.F_PROG.Caption = "Заполняю таблицу EXCEL..."
*-- Формируем данные и выводим их
SELECT COUNT(*) FROM ALIAS() INTO ARRAY laCount
m.F_PROG.pCount = laCount[1]
m.F_PROG.Show()
ELSE
WAIT WINDOW "Заполняю таблицу EXCEL..." NOWAIT NOCLEAR AT SROWS()/2, SCOLS()/2
ENDIF
SET CENTURY ON
SELECT (m.lcAlias)
GOTO TOP
m.i = 2
SCAN
IF m.lnModeView > 0
WAIT CLEAR
IF m.F_PROG.CancelFlag
IF MESSAGEBOX("Прервать экспорт данных?",4+32,"Экспорт в EXCEL") = IDYES
EXIT
ENDIF
m.F_PROG.CancelFlag = .F.
ENDIF
DOEVENTS
m.F_PROG.RefreshDisplay()
ENDIF
m.loExcel.Cells(m.i, 1).Value = m.i - 1
FOR m.j = 1 TO lnCount
m.lValue = ""
IF m.lnFlag <> 1
m.lValue = EVALUATE(FIELD(m.j))
ELSE
FOR m.jj = 1 TO m.loSource.ColumnCount
IF m.j = m.loSource.Columns(m.jj).ColumnOrder
m.lcCommand = "m.loSource.Columns(m.jj)." + m.loSource.Columns(m.jj).CurrentControl + ".BaseClass"
IF EVALUATE(m.lcCommand) = "Editbox"
m.loExcel.Cells(m.i, m.j+1).WrapText = .T.
ENDIF
m.lValue = EVALUATE(m.loSource.Columns(m.jj).ControlSource)
EXIT
ENDIF
ENDFOR
ENDIF
WITH m.loExcel.Cells(m.i, m.j+1)
DO CASE
CASE VARTYPE(m.lValue) == "N"
.Value = IIF( m.lValue = 0, '', m.lValue)
CASE VARTYPE(m.lValue) == "C"
.Value = ALLTRIM(m.lValue)
CASE VARTYPE(m.lValue) == "D"
SET CENTURY ON
SET MARK TO "."
.Value = IIF(ISBLANK(m.lValue), "",DTOC(m.lValue))
CASE VARTYPE(m.lValue) == "T"
.Value = IIF(EMPTY(m.lValue), "", TTOC(m.lValue))
OTHERWISE
.Value = m.lValue
ENDCASE
ENDWITH
ENDFOR
m.i = m.i + 1
ENDSCAN
RELEASE F_PROG
WAIT CLEAR
SET CENTURY &lOlsSET_CENTURY
m.loExcel.Columns("A:AZ").EntireColumn.AutoFit
IF !EMPTY(m.lcCaption) AND VARTYPE(m.lcCaption) == "C"
WITH m.loExcel.Cells(1, 1)
.Value = m.lcCaption
WITH .Font
.Bold = .T.
.Size = 14
ENDWITH
ENDWITH
ENDIF
*-- Прячем невидимые колонки если lnFlag = 1
IF m.lnFlag = 1
FOR m.i = 1 TO m.loSource.ColumnCount
IF (m.loSource.Columns(m.i).Width <= 0) OR !m.loSource.Columns(m.i).Visible
m.loExcel.Columns(m.loSource.Columns(m.i).ColumnOrder + 1).Select
m.loExcel.Selection.EntireColumn.Hidden = .T.
ENDIF
ENDFOR
ENDIF
IF m.lnRecno > 0
GOTO (m.lnRecno)
ENDIF
IF !EMPTY(m.lcNameFile)
m.loExcel.Workbooks(1).SaveAs(m.lcNameFile)
ENDIF
IF VARTYPE(m.loExcel) == "O" AND !ISNULL(m.loExcel)
m.loExcel.Quit
ENDIF
SET MARK TO "/"
THISFORM.MYGrid1.MousePointer=0
RELEASE loExcel
[/code]