Экспорт из 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;

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

ffpereverzev · #7 01.03.2017, 08:34

Я, наверное, не очень правильно объясняю.

Я понимаю, что видимость можно убрать строкой:

Код:

ExcelApp.Visible:= false;

, но в таком случае у меня как раз и появляется ошибка OLE error 800AC472.
Убрать данную ошибку как раз и получилось с помощью изменения свойства видимости (то есть сначала я делаю окно невидимым, а затем видимым и тогда ошибка не возникает):

Код:

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

, а иначе, почему-то, процесс закрытия приложения

Код:

MyDoc.Workbooks.Close;
MyDoc.Quit;
MyDoc:=UnAssigned

работает как-то некорректно

Спасибо большое за ответы! Попробую реализовать конструкцию:

Код:

if MyDoc <> nil then...

, если получится решить проблему - отпишусь.

ffpereverzev · #8 01.03.2017, 11:08

Вдруг кому-то будет интересно.

При экспорте данных из StringGrid в ячейки Excel обнаружилась интересная особенность: когда экспортируются данные в ячейки, которые были отформатированы изначально как денежные или числовые, то если разделитель ",", а не ".", то ячейки меняют свой формат на "Текстовый" (при настройках российской локализации MS Windows где, соответственно, разделитель целой и дробной части ","). Я решил эту проблему таким образом:
1. Во-первых, ввел ограничение на тип вводимых символов в StringGrid;
2. Во-вторых, сделал конвертацию символа "," в символ "."

Код:

procedure TForm7.StringGrid1KeyPress(Sender: TObject; var Key: Char);
    begin
        // Обработка столбца для ввода текстовых значений
        if (StringGrid1.Col=0) then
          if not (key in ['а'..'я','А'..'Я',' ','-',#8]) then key:=#0;
        // Обработка столбца для ввода цифровых значений
        if (StringGrid1.Col=1) then
          if not (key in ['0'..'9','.',Sysutils.DecimalSeparator,#8]) then key:=#0;
          // Замена символа "," на символ "."
          if key in [','] then key := '.';
    end;

Alegun · #9 01.03.2017, 11:53

А чтож латиницы-то в условии оператора нету, вдруг потребуется, и кстати, букву ё тоже отдельно обрабатывать нужно, в наборе 'а'..'я' ей почему-то нехватило места

Код:

// Обработка столбца для ввода текстовых значений
        if (StringGrid1.Col=0) and 
           (not (key in ['а'..'я','А'..'Я','ё','Ё',' ','-',#8])) then key:=#0;

ffpereverzev · #10 01.03.2017, 12:07

А латиницу я специально не включил в обработку, ибо он не требуется (в данном столбце только названия типов документов (чек, авиабилет, квитанция...и.т.п), а вот за букву "ё" СПАСИБО ОГРОМНОЕ!

ffpereverzev · #11 01.03.2017, 12:11

Цитата:

Сообщение от ffpereverzev

Вдруг кому-то будет интересно.

При экспорте данных из StringGrid в ячейки Excel обнаружилась интересная особенность: когда экспортируются данные в ячейки, которые были отформатированы изначально как денежные или числовые, то если разделитель ",", а не ".", то ячейки меняют свой формат на "Текстовый" (при настройках российской локализации MS Windows где, соответственно, разделитель целой и дробной части ","). Я решил эту проблему таким образом:
1. Во-первых, ввел ограничение на тип вводимых символов в StringGrid;
2. Во-вторых, сделал конвертацию символа "," в символ "."

Код:

procedure TForm7.StringGrid1KeyPress(Sender: TObject; var Key: Char);
    begin
        // Обработка столбца для ввода текстовых значений
        if (StringGrid1.Col=0) then
          if not (key in ['а'..'я','А'..'Я',' ','-',#8]) then key:=#0;
        // Обработка столбца для ввода цифровых значений
        if (StringGrid1.Col=1) then
          if not (key in ['0'..'9','.',Sysutils.DecimalSeparator,#8]) then key:=#0;
          // Замена символа "," на символ "."
          if key in [','] then key := '.';
    end;

И в дополнение к вышеуказанному коду. Чтобы уж наверняка решить проблему изменения формата при циклическом заполнении ячеек получилось сотворить следующее извращение:

Код:

// Заполнение ячеек документа Excel
    j:= 1;
    for i := 17 to 39{40} do
     begin
       // Заполнение столбца "Отчетные документы"
       MyDoc.Range['C' + IntToStr(i)]:= StringGrid1.Cells[0,j];
       // Заполнение столбца "Стоимость"
       MyDoc.Range['J' + IntToStr(i)]:= StringGrid1.Cells[1,j];
       // Приравнивание формата заполняемых ячеек формату уже существующей ячейки
       MyDoc.Range['J' + IntToStr(i)].NumberFormat:= MyDoc.Range['J16'].NumberFormat;
       Inc(j);
     end;

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

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

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

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