скрыть

скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

Экспортировать TStringGrid в Excel-файл



Оформил: DeeCo

{ With OLE Automation }

 uses
   ComObj;

 function RefToCell(ARow, ACol: Integer): string;
 begin
   Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);
 end;

 function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;
 const
   xlWBATWorksheet = -4167;
 var
   Row, Col: Integer;
   GridPrevFile: string;
   XLApp, Sheet, Data: OLEVariant;
   i, j: Integer;
 begin
   // Prepare Data 
  Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);
   for i := 0 to AGrid.ColCount - 1 do
     for j := 0 to AGrid.RowCount - 1 do
       Data[j + 1, i + 1] := AGrid.Cells[i, j];
   // Create Excel-OLE Object 
  Result := False;
   XLApp := CreateOleObject('Excel.Application');
   try
     // Hide Excel 
    XLApp.Visible := False;
     // Add new Workbook 
    XLApp.Workbooks.Add(xlWBatWorkSheet);
     Sheet := XLApp.Workbooks[1].WorkSheets[1];
     Sheet.Name := ASheetName;
     // Fill up the sheet 
    Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,
       AGrid.ColCount)].Value := Data;
     // Save Excel Worksheet 
    try
       XLApp.Workbooks[1].SaveAs(AFileName);
       Result := True;
     except
       // Error ? 
    end;
   finally
     // Quit Excel 
    if not VarIsEmpty(XLApp) then
     begin
       XLApp.DisplayAlerts := False;
       XLApp.Quit;
       XLAPP := Unassigned;
       Sheet := Unassigned;
     end;
   end;
 end;

 // Example: 

procedure TForm1.Button1Click(Sender: TObject);
 begin
   if SaveAsExcelFile(stringGrid1, 'My Stringgrid Data', 'c:\MyExcelFile.xls') then
     ShowMessage('StringGrid saved!');
 end;







Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook