Экспорт из StringGrid в Excel

ffpereverzev · #1 28.02.2017, 14:45

Здравствуйте, уважаемые форумчане!
Пусть Вас не вводит в заблуждение возможная похожесть моей темы. Я, по крайней мере, не нашел необходимых мне тем (возможно, что плохо искал).
Вопрос, собственно, вот в чем: пытаюсь экспортировать данные из StringGrid в Excel, но не в виде таблицы, а в определенные ячейки листа MS Excel. Все темы, которые мне попадались, подсказывали как сделать экспорт из StringGrid в виде таблицы.
Я, конечно же, понимаю, что можно сделать обыкновенное присвоение ячеек StringGrid ячейкам Excel, но если таковых будет много, код будет выглядеть дико. А как это сделать в цикле мне пока не додуматься.
Буду признателен за любой совет и любую помощь. (может быть похожая тема где-то уже поднималась, тогда буду признателен за ссылку)

Alegun · #2 28.02.2017, 16:07

Можно в циклах пробежать по StringGrid и по листу в книжке эксель средствами _WorkSheet и если текущая ячейка подходит под условия пробежки, вставить данные в неё из сетки, TExcelApplication.ActiveCell.Row/ActiveCell.Column вам в помощь, чтоб более конкретно, кажите пример данных

ffpereverzev · #3 28.02.2017, 16:16

На данный момент я сделал так, как было грубо, но просто:

Код:

procedure TForm7.Button1Click(Sender: TObject);
  begin
    ProgressBar1.Position:=0;
    Timer1.Enabled:=true;
    MyDoc := CreateOleObject('Excel.Application');
    MyDoc.Workbooks.Open(ExtractFilePath(Application.ExeName)+'Отчет.xlt');
    MyDoc.Visible := False;
    MyDoc.Range['D4'] := ComboBox1.Text;
    MyDoc.Range['E6'] := DateTimePicker1.DateTime;
    MyDoc.Range['G6'] := DateTimePicker2.DateTime;
    MyDoc.Range['D10'] := Edit1.Text;
    MyDoc.Range['D12'] := Edit2.Text;
    // Заполнение столбца "Отчетные документы"
    MyDoc.Range['C18'] := StringGrid1.Cells[0,1];
    MyDoc.Range['C19'] := StringGrid1.Cells[0,2];
    MyDoc.Range['C20'] := StringGrid1.Cells[0,3];
    MyDoc.Range['C21'] := StringGrid1.Cells[0,4];
    MyDoc.Range['C22'] := StringGrid1.Cells[0,5];
    MyDoc.Range['C23'] := StringGrid1.Cells[0,6];
    MyDoc.Range['C24'] := StringGrid1.Cells[0,7];
    MyDoc.Range['C25'] := StringGrid1.Cells[0,8];
    MyDoc.Range['C26'] := StringGrid1.Cells[0,9];
    MyDoc.Range['C27'] := StringGrid1.Cells[0,10];
    MyDoc.Range['C28'] := StringGrid1.Cells[0,11];
    MyDoc.Range['C29'] := StringGrid1.Cells[0,12];
    MyDoc.Range['C30'] := StringGrid1.Cells[0,13];
    MyDoc.Range['C31'] := StringGrid1.Cells[0,14];
    MyDoc.Range['C32'] := StringGrid1.Cells[0,15];
    MyDoc.Range['C33'] := StringGrid1.Cells[0,16];
    MyDoc.Range['C34'] := StringGrid1.Cells[0,17];
    MyDoc.Range['C35'] := StringGrid1.Cells[0,18];
    MyDoc.Range['C36'] := StringGrid1.Cells[0,19];
    MyDoc.Range['C37'] := StringGrid1.Cells[0,20];
    MyDoc.Range['C38'] := StringGrid1.Cells[0,21];
    MyDoc.Range['C39'] := StringGrid1.Cells[0,22];
    MyDoc.Range['C40'] := StringGrid1.Cells[0,23];
    // Заполнение столбца "Стоимость"
    MyDoc.Range['J18'] := StringGrid1.Cells[1,1];
    MyDoc.Range['J19'] := StringGrid1.Cells[1,2];
    MyDoc.Range['J20'] := StringGrid1.Cells[1,3];
    MyDoc.Range['J21'] := StringGrid1.Cells[1,4];
    MyDoc.Range['J22'] := StringGrid1.Cells[1,5];
    MyDoc.Range['J23'] := StringGrid1.Cells[1,6];
    MyDoc.Range['J24'] := StringGrid1.Cells[1,7];
    MyDoc.Range['J25'] := StringGrid1.Cells[1,8];
    MyDoc.Range['J26'] := StringGrid1.Cells[1,9];
    MyDoc.Range['J27'] := StringGrid1.Cells[1,10];
    MyDoc.Range['J28'] := StringGrid1.Cells[1,11];
    MyDoc.Range['J29'] := StringGrid1.Cells[1,12];
    MyDoc.Range['J30'] := StringGrid1.Cells[1,13];
    MyDoc.Range['J31'] := StringGrid1.Cells[1,14];
    MyDoc.Range['J32'] := StringGrid1.Cells[1,15];
    MyDoc.Range['J33'] := StringGrid1.Cells[1,16];
    MyDoc.Range['J34'] := StringGrid1.Cells[1,17];
    MyDoc.Range['J35'] := StringGrid1.Cells[1,18];
    MyDoc.Range['J36'] := StringGrid1.Cells[1,19];
    MyDoc.Range['J37'] := StringGrid1.Cells[1,20];
    MyDoc.Range['J38'] := StringGrid1.Cells[1,21];
    MyDoc.Range['J39'] := StringGrid1.Cells[1,22];
    MyDoc.Range['J40'] := StringGrid1.Cells[1,23];
    MyDoc.DisplayAlerts := False;
    MyDoc.ActiveWorkBook.SaveAs(ExtractFilePath(Application.ExeName)+'Отчет_'+FormatDateTime('ddmmyyyy_hhmm', Now)+'.xls');
  end;

Alegun · #4 28.02.2017, 16:27

Можно просто и подсократить

Код:

procedure TForm7.Button1Click(Sender: TObject);
 var
 i, j: integer;
  begin
    ProgressBar1.Position:=0;
    Timer1.Enabled:=true;
    MyDoc := CreateOleObject('Excel.Application');
    MyDoc.Workbooks.Open(ExtractFilePath(Application.ExeName)+'Отчет.xlt');
    MyDoc.Visible := False;
    MyDoc.Range['D4'] := ComboBox1.Text;
    MyDoc.Range['E6'] := DateTimePicker1.DateTime;
    MyDoc.Range['G6'] := DateTimePicker2.DateTime;
    MyDoc.Range['D10'] := Edit1.Text;
    MyDoc.Range['D12'] := Edit2.Text;

    j:= 1;
    for i := 18 to 39{40} do
     begin
    // Заполнение столбца "Отчетные документы"
      MyDoc.Range['C' + IntToStr(i)]:= StringGrid1.Cells[0,j];
    // Заполнение столбца "Стоимость"
      MyDoc.Range['J' + IntToStr(i)]:= StringGrid1.Cells[1,j];
      Inc(j);
      end;
    MyDoc.DisplayAlerts := False;
    MyDoc.ActiveWorkBook.SaveAs(ExtractFilePath(Application.ExeName)+'Отчет_'+FormatDateTime('ddmmyyyy_hhmm', Now)+'.xls');
  end;

ffpereverzev · #5 28.02.2017, 20:07

Спасибо большое! Все работает!
Единственное, всплыла плавающая проблема: в процессе выполнения операции возникает ошибка: OLE error 800AC472. Как я понял - это ошибка занятости приложения (Раз на раз не приходится. То есть один раз приложение срабатывает нормально, без ошибок, а в другой раз с ошибкой). Эту ошибку получилось исправить с помощью изменения свойства Visible для создаваемого документа:

Код:

//В начале кода, после открытия шаблона MS Excel
MyDoc.Visible := False;

//В конце кода, после заполнения ячеек MS Excel данными
MyDoc.Visible := True;

Только теперь документ открывается в процессе создания и закрывается, когда выходит ScrollBar (согласно моему коду). Вопрос: есть ли возможность как-то скрыть документ? (чтобы он не появлялся в процессе создания) Может есть какие-то варианты? Это, конечно, не принципиально, но все таки хотелось бы навести красивость. Таймер установлен на 5 секунд (вычислил опытным путем; это время, необходимое для корректного завершения процесса).

Код с обработчиком ScrollBar-а:

Код:

procedure TForm7.Button1Click(Sender: TObject);
  var
  i, j: integer;
  begin
    ProgressBar1.Position:=0;
    Timer1.Enabled:=true;
    MyDoc := CreateOleObject('Excel.Application');
    MyDoc.Workbooks.Add(ExtractFilePath(Application.ExeName)+'Финансовый_отчет.xlt');
    MyDoc.Visible := False;
    MyDoc.Range['D4'] := ComboBox1.Text;
    MyDoc.Range['E6'] := DateTimePicker1.DateTime;
    MyDoc.Range['G6'] := DateTimePicker2.DateTime;
    MyDoc.Range['D10'] := Edit1.Text;
    MyDoc.Range['D12'] := Edit2.Text;
    
// Заполнение ячеек документа Excel
    j:= 1;
    for i := 18 to 39{40} do
     begin
    // Заполнение столбца "Отчетные документы"
      MyDoc.Range['C' + IntToStr(i)]:= StringGrid1.Cells[0,j];
    // Заполнение столбца "Стоимость"
      MyDoc.Range['J' + IntToStr(i)]:= StringGrid1.Cells[1,j];
      Inc(j);
      end;

    MyDoc.Visible := True;
    MyDoc.DisplayAlerts := False;
    MyDoc.ActiveWorkBook.SaveAs(ExtractFilePath(Application.ExeName)+'Финансовый_отчет_'+FormatDateTime('ddmmyyyy_hhmm', Now)+'.xls');
  end;

procedure TForm7.Timer1Timer(Sender: TObject);
  begin
    if ProgressBar1.Position < ProgressBar1.Max then
       ProgressBar1.Position:=ProgressBar1.Position+1
    else
  begin
       Timer1.Enabled:=false;
       ShowMessage('Создание отчета выполнено!');
       ProgressBar1.Position:=0;
       MyDoc.Workbooks.Close;
       MyDoc.Quit;
       MyDoc:=UnAssigned
  end;
end;

Может, у меня где-нибудь есть логическая или системная ошибка?

Alegun · #6 28.02.2017, 23:58

OLE error 800AC472 - это, еслправнпомн, одновременнное обращение нескольких потоков к одной книге экзеля, и видимо, ни к чему хорошему это не приводит, т.е. возможно нужна проверка после создания олиобжекта типа if MyDoc <> nil then...

Насчёт как убрать видимость, вот вариант

Код:

var
   ExcelApp : Variant;
begin
try
    ExcelApp:= GetActiveOleObject('Excel.Application');
   ExcelApp.Visible:= false;
except
end;

не проверял, "кошечек" для тренировки нема

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты

Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
ffpereverzev (28.02.2017)

Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
ffpereverzev (01.03.2017)