Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 1 093

Раздел: Delphi » COM, ActiveX и взаимодействие с другими приложениями
/ вопрос открыт /

Приветствую, уважаемые эксперты!Мне необходимо сохранять StringGrid в Excel,нашёл TExcelApplication
приведите пожалуйста пример работы с ним(желательно сохранение в автоформате,ну там и другие опции).

GAZ Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: GAZ (статус: Посетитель)
Вопрос отправлен: 6 ноября 2007, 07:33
Состояние вопроса: открыт, ответов: 2.

Ответ #1. Отвечает эксперт: Николай Рубан

Здравствуйте, GAZ!

Все достаточно просто.

Создаем рабочую книгу, только одно ЗАМЕЧАНИЕ - я создаю объекты TExcelApplication, ExcelWorkbook, ExcelWorkSheet вручную, соответственно и модули тоже
uses OleServer, ExcelXP, ComObj, VarUtils; {список может быть и меньше - это Вы определите опытным путем ;)}
(Вы же можете этого не делать... - просто расположите необходимые объекты на форме):

var ExlApp: TExcelApplication;
ExlWorkBook: ExcelWorkbook;
ExlWorkSheet: ExcelWorkSheet;
...
procedure TForm1.FormCreate(Sender: TObject);
begin
ExlApp:=TExcelApplication.Create(Self);
ExlApp.ConnectKind := ckNewInstance;
ExlApp.AutoQuit:=true;
ExlApp.Visible[LOCALE_USER_DEFAULT]:=true;
ExlWorkBook:=ExlApp.Workbooks.Add(EmptyParam,0);
ExlWorkSheet:=ExlApp.ActiveWorkbook.ActiveSheet as ExcelWorksheet;
end;
....

И непосредственно заполняем ячейки листа данными из StringGrid-a:
procedure TForm1.Button3Click(Sender: TObject);
var i,j:integer;
cell:String;
begin
with StringGrid1 do
for i:=0 to ColCount-1 do
for j:=0 to RowCount-1 do
begin
cell:=format('%s%d',[chr(ord('A')+j),i+1]); //формируем адрес ячейки в которую будем вносить данные
ExlApp.Range[cell, EmptyParam].Value[xlRangeValueDefault] := Cells[j,i]; //непосредственно помещение даных
end;
end;

Рассмотрим строку
cell:=format('%s%d',[chr(ord('A')+j),i+1]);
при i=0 и j=0 мы получим cell='A1'
Следовательно заполнение данными начинается с адреса 'A1', если Вам необходимо начать вносить данные с другого адреса, то просто измените эту строку.
Например для начала с адреса 'F3' достаточно сделать такой оператор:
cell:=format('%s%d',[chr(ord('F')+j),i+3]);

Good Luck!!!

Ответ отправил: Николай Рубан (статус: 10-ый класс)
Время отправки: 6 ноября 2007, 10:03

Ответ #2. Отвечает эксперт: Feniks

Здравствуйте, GAZ!
Держите пару примеров в Приложении. Если у Вас StringGrid очень большой и надо много данных экспортировать, тогда лучше не использовать OLE объекты Оффиса, а делать на прямую в файл XLS. Для этого есть компоненты, например, VTKExport из библиотеки VTKTools. В атаче пример работы с ним.
К ответу прикреплён файл. Загрузить » (срок хранения: 60 дней с момента отправки ответа)

Приложение:
  1.  
  2.  
  3. uses
  4. ComObj;
  5. procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word;
  6. const AValue: string);
  7. var
  8. L: Word;
  9. const
  10. {$J+}
  11. CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
  12. {$J-}
  13. begin
  14. L := Length(AValue);
  15. CXlsLabel[1] := 8 + L;
  16. CXlsLabel[2] := ARow;
  17. CXlsLabel[3] := ACol;
  18. CXlsLabel[5] := L;
  19. XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
  20. XlsStream.WriteBuffer(Pointer(AValue)^, L);
  21. end;
  22.  
  23. function SaveAsExcelFile(AGrid: TStringGrid; AFileName: string): Boolean;
  24. const
  25. {$J+} CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); {$J-}
  26. CXlsEof: array[0..1] of Word = ($0A, 00);
  27. var
  28. FStream: TFileStream;
  29. I, J: Integer;
  30. begin
  31. Result := False;
  32. FStream := TFileStream.Create(PChar(AFileName), fmCreate or fmOpenWrite);
  33. try
  34. CXlsBof[4] := 0;
  35. FStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
  36. for i := 0 to AGrid.ColCount - 1 do
  37. for j := 0 to AGrid.RowCount - 1 do
  38. XlsWriteCellLabel(FStream, I, J, AGrid.cells[i, j]);
  39. FStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
  40. Result := True;
  41. finally
  42. FStream.Free;
  43. end;
  44. end;
  45.  
  46. // Example:
  47.  
  48. procedure TForm1.Button2Click(Sender: TObject);
  49. begin
  50. if SaveAsExcelFile(StringGrid1, 'c:MyExcelFile.xls') then
  51. ShowMessage('StringGrid saved!');
  52. end;
  53.  
  54. ============================================================
  55.  
  56.  
  57. { Code by Reinhard Schatzl }
  58.  
  59. uses
  60. ComObj;
  61.  
  62. // Hilfsfunktion fur StringGridToExcelSheet
  63. // Helper function for StringGridToExcelSheet
  64. function RefToCell(RowID, ColID: Integer): string;
  65. var
  66. ACount, APos: Integer;
  67. begin
  68. ACount := ColID div 26;
  69. APos := ColID mod 26;
  70. if APos = 0 then
  71. begin
  72. ACount := ACount - 1;
  73. APos := 26;
  74. end;
  75.  
  76. if ACount = 0 then
  77. Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);
  78.  
  79. if ACount = 1 then
  80. Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
  81.  
  82. if ACount > 1 then
  83. Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
  84. end;
  85.  
  86. // StringGrid Inhalt in Excel exportieren
  87. // Export StringGrid contents to Excel
  88. function StringGridToExcelSheet(Grid: TStringGrid; SheetName, FileName: string;
  89. ShowExcel: Boolean): Boolean;
  90. const
  91. xlWBATWorksheet = -4167;
  92. var
  93. SheetCount, SheetColCount, SheetRowCount, BookCount: Integer;
  94. XLApp, Sheet, Data: OLEVariant;
  95. I, J, N, M: Integer;
  96. SaveFileName: string;
  97. begin
  98. //notwendige Sheetanzahl feststellen
  99. SheetCount := (Grid.ColCount div 256) + 1;
  100. if Grid.ColCount mod 256 = 0 then
  101. SheetCount := SheetCount - 1;
  102. //notwendige Bookanzahl feststellen
  103. BookCount := (Grid.RowCount div 65536) + 1;
  104. if Grid.RowCount mod 65536 = 0 then
  105. BookCount := BookCount - 1;
  106.  
  107. //Create Excel-OLE Object
  108. Result := False;
  109. XLApp := CreateOleObject('Excel.Application');
  110. try
  111. //Excelsheet anzeigen
  112. if ShowExcel = False then
  113. XLApp.Visible := False
  114. else
  115. XLApp.Visible := True;
  116. //Workbook hinzufugen
  117. for M := 1 to BookCount do
  118. begin
  119. XLApp.Workbooks.Add(xlWBATWorksheet);
  120. //Sheets anlegen
  121. for N := 1 to SheetCount - 1 do
  122. begin
  123. XLApp.Worksheets.Add;
  124. end;
  125. end;
  126. //Sheet ColAnzahl feststellen
  127. if Grid.ColCount <= 256 then
  128. SheetColCount := Grid.ColCount
  129. else
  130. SheetColCount := 256;
  131. //Sheet RowAnzahl feststellen
  132. if Grid.RowCount <= 65536 then
  133. SheetRowCount := Grid.RowCount
  134. else
  135. SheetRowCount := 65536;
  136.  
  137. //Sheets befullen
  138. for M := 1 to BookCount do
  139. begin
  140. for N := 1 to SheetCount do
  141. begin
  142. //Daten aus Grid holen
  143. Data := VarArrayCreate([1, Grid.RowCount, 1, SheetColCount], varVariant);
  144. for I := 0 to SheetColCount - 1 do
  145. for J := 0 to SheetRowCount - 1 do
  146. if ((I + 256 * (N - 1)) <= Grid.ColCount) and
  147. ((J + 65536 * (M - 1)) <= Grid.RowCount) then
  148. Data[J + 1, I + 1] := Grid.Cells[I + 256 * (N - 1), J + 65536 * (M - 1)];
  149. //-------------------------
  150. XLApp.Worksheets[N].Select;
  151. XLApp.Workbooks[M].Worksheets[N].Name := SheetName + IntToStr(N);
  152. //Zellen als String Formatieren
  153. XLApp.Workbooks[M].Worksheets[N].Range[RefToCell(1, 1),
  154. RefToCell(SheetRowCount, SheetColCount)].Select;
  155. XLApp.Selection.NumberFormat := '@';
  156. XLApp.Workbooks[M].Worksheets[N].Range['A1'].Select;
  157. //Daten dem Excelsheet ubergeben
  158. Sheet := XLApp.Workbooks[M].WorkSheets[N];
  159. Sheet.Range[RefToCell(1, 1), RefToCell(SheetRowCount, SheetColCount)].Value :=
  160. Data;
  161. end;
  162. end;
  163. //Save Excel Worksheet
  164. try
  165. for M := 1 to BookCount do
  166. begin
  167. SaveFileName := Copy(FileName, 1,Pos('.', FileName) - 1) + IntToStr(M) +
  168. Copy(FileName, Pos('.', FileName),
  169. Length(FileName) - Pos('.', FileName) + 1);
  170. XLApp.Workbooks[M].SaveAs(SaveFileName);
  171. end;
  172. Result := True;
  173. except
  174. // Error ?
  175. end;
  176. finally
  177. //Excel Beenden
  178. if (not VarIsEmpty(XLApp)) and (ShowExcel = False) then
  179. begin
  180. XLApp.DisplayAlerts := False;
  181. XLApp.Quit;
  182. XLAPP := Unassigned;
  183. Sheet := Unassigned;
  184. end;
  185. end;
  186. end;
  187.  
  188. //Example
  189. procedure TForm1.Button1Click(Sender: TObject);
  190. begin
  191. //StringGrid inhalt in Excel exportieren
  192. //Grid : stringGrid, SheetName : stringgrid Print, Pfad : c:TestExcelFile.xls, Excelsheet anzeigen
  193. StringGridToExcelSheet(StringGrid, 'Stringgrid Print', 'c:TestExcelFile.xls', True);
  194. end;


Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 6 ноября 2007, 11:36


Мини-форум вопроса

Всего сообщений: 6; последнее сообщение — 9 ноября 2007, 10:39; участников в обсуждении: 4.
min@y™

min@y™ (статус: Доктор наук), 6 ноября 2007, 08:18 [#1]:

Откопал примерчик у себя на винте, но без TExcelApplication. Поэтому публикую не как ответ, а в форуме. Попробовал, вроде работает (Excel 2007). Подумал - может пригодится.
procedure TMainForm.Button1Click(Sender: TObject);
var 
   ServerIsRunning : boolean; 
   Unknown : IUnknown; 
   Result : HResult;
   AppProgID : String; 
   App : Variant;
   i,j:Integer;
begin
 //Указать программный идентификатор приложения-сервера
 AppProgID:='Excel.Application';
 ServerIsRunning := False;
 Result := GetActiveObject(ProgIDToClassID(AppProgID),nil,Unknown);
 if (Result = MK_E_UNAVAILABLE) then
 //Создать один экземпляр сервера
 App := CreateOleObject(AppProgID)
 else
  begin
   //Соединиться с уже запущенной копией сервера
   App := GetActiveOleObject(AppProgID);
   ServerIsRunning := True;
  end;
  //показать окно приложения на экране
  App.Visible := True;
  App.WorkBooks.Add;
  try
   for i:=0 to Grid.RowCount-1 do
    for j:=0 to Grid.ColCount-1 do
     begin
      App.ActiveWorkBook.WorkSheets[1].Cells[i+1,j+1].Value:=Grid.Cells[j,i];
     end;
  except
   Application.MessageBox(PChar('Упс!'),'Ошибка',mb_Ok+mb_IconError);
  end;
 if not ServerIsRunning then App.Quit;
 App:=Unassigned;
end;
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
GAZ

GAZ (статус: Посетитель), 8 ноября 2007, 17:40 [#2]:

Н. Рубан:
1. cell:=format('%s%d',[chr(ord('A')+j),i+1]);
.... после этой строчки прога вылетает и кроме как заголовка столбцов в Excel ничего больше не заноситься

2.А всё таки как выполнить программно автоформат в Excel ,нашёл вроде опцию с аналогичным названием ,но в ней что то очень много параметров,может расскажете о них
Николай Рубан

Николай Рубан (статус: 10-ый класс), 8 ноября 2007, 18:50 [#3]:

А Вы мой код использовали один в один? Или же внесли некие коррективы?
Если да, то прошу привести полный код Вашей программы...

У меня все работает!!! Перед отправкой ответа я все коды тестирую ;)
GAZ

GAZ (статус: Посетитель), 8 ноября 2007, 19:04 [#4]:

Вроде один в один,есть правда одна штука может из за неё,у моего StringGrid многострочный заголовок и все записи в нём сцентрированны.
Николай Рубан

Николай Рубан (статус: 10-ый класс), 8 ноября 2007, 20:35 [#5]:

Так возьмите и испытайте мой код на ПРОСТОМ гриде без изысков, и если вы получите результат, значит нужно искать проблему именно в заголовках Вашего грида.
Feniks

Feniks (статус: Бакалавр), 9 ноября 2007, 10:39 [#6]:

Попробуйте еще компонент XLSReadWrite:
Мощный компонент для работы с файлами *.xls.
Объём: 263 Кб
Формат файла: RAR
Версия: 1.15.02
Качать тут

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 07:29
Выполнено за 0.03 сек.