Jak pokazać w Excelu dane z tabeli

jozkan

Dane są pokazane w StringGridzie. Button uruchamia Excela. Podałem cały unit Formy, żeby początkujący nie mieli problemu (na Formę trzeba wrzucić StringGrida i zmienić Name na SG, Buttona oraz ExcelApplication1 i ExcelWorkBook1)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, Excel97, OleServer;

type
  TForm1 = class(TForm)
    ExcelApplication1: TExcelApplication;
    ExcelWorkbook1: TExcelWorkbook;
    SG: TStringGrid;
    Button1: TButton;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

procedure StringGridDoExcela(aForm:TForm;SG:TStringGrid;ExcelApplication1:TExcelApplication;ExcelWorkBook1:TExcelWorkBook);

implementation

{$R *.DFM}

procedure StringGridDoExcela(aForm:TForm;SG:TStringGrid;ExcelApplication1:TExcelApplication;ExcelWorkBook1:TExcelWorkBook);
var
   w,k:Integer;
   Arkusz:TExcelWorkSheet;
   Temp_Worksheet: _WorkSheet;
begin
   try
      ExcelApplication1.Connect;
      {w pasku tytulu}
      ExcelApplication1.Caption:='Przykład eksportu StringGrida do Excela';
      ExcelWorkBook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,0));
      Temp_Worksheet:=ExcelWorkbook1.
      WorkSheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)as _WorkSheet;
      Arkusz:=TExcelWorkSheet.Create(aForm);
      Arkusz.ConnectTo(Temp_WorkSheet);
      Arkusz.Name:='StringGrid';
      ExcelApplication1.Visible[0]:=True;
      ExcelApplication1.ScreenUpdating[0] := True;
      {wypełnianie komórek}
      for k:=0 to SG.ColCount-1 do
      for w:=0 to SG.RowCount-1 do
      with Arkusz do
      begin
         {zawijaj tekst}
         Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].WrapText:=True;
         {obramowanie komórki}
         Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Borders[xlEdgeTop].LineStyle:=xlContinuous;
         Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Borders[xlEdgeBottom].LineStyle:=xlContinuous;
         Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Borders[xlEdgeLeft].LineStyle:=xlContinuous;
         Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Borders[xlEdgeRight].LineStyle:=xlContinuous;
         if (w=0)or(k=0) then
         begin
           {pogrubienie krawędzi}
            Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Borders[xlEdgeLeft].Weight:=xlMedium;
            Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Borders[xlEdgeRight].Weight:=xlMedium;
            Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Borders[xlEdgeTop].Weight:=xlMedium;
            Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Borders[xlEdgeBottom].Weight:=xlMedium;
           {dodanie tła}
            Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Interior.ColorIndex:=15;
            Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Interior.Pattern:=xlSolid;
            Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Interior.PatternColorIndex:=15;
         end;
         {orientacja tekstu
         Range[Cells.Item[w+1,k+1],Cells.Item[w+1,k+1]].Orientation:=90;}
         {wyrownanie tekstu}
         Cells.Item[w+1,k+1].HorizontalAlignment:=xlCenter;
         Cells.Item[w+1,k+1].VerticalAlignment:=xlCenter;
         {czcionka}
         Cells.Item[w+1,k+1].Font.Name:='Arial';
         Cells.Item[w+1,k+1].Font.Size:=12;
         {format}
         if (w=0)or(k=0) then
         Cells.Item[w+1,k+1].Font.Bold:=True else
         Cells.Item[w+1,k+1].Font.Bold:=False; {Italic,Underline,StrikeThrough}
         {wpisy}
         Cells.Item[w+1,k+1].Value:=SG.Cells[k,w];
      end;
      ExcelWorkbook1.Disconnect;
      ExcelApplication1.Disconnect;
      Arkusz.Free;
   except
      ShowMessage('W Twoim komputerze nie jest zainstalowany MS Excel lub aplikacja ta jest uszkodzona albo też przerwałeś(aś) pracę aplikacjii !');
   end;
end;


procedure TForm1.FormShow(Sender: TObject);
var
   aCol,ARow:Integer;
begin
   for aCol:=0 to SG.ColCount-1 do
   for aRow:=0 to SG.RowCount-1 do
   with SG do
   begin
      if (aCol=0)and(aRow>0) then Cells[aCol,aRow]:=IntToStr(aRow) else
      if (aRow=0)and(aCol=0) then Cells[aCol,aRow]:='Lp' else
      if (aRow=0)and(aCol>0) then Cells[aCol,aRow]:='Dane '+ IntToStr(aCol)else
      Cells[aCol,aRow]:=IntToStr(aCol)+IntToStr(aRow);
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   StringGridDoExcela(Form1,SG,ExcelApplication1,ExcelWorkBook1);
end;

end.

3 komentarzy

A mi nie działa :/
Po naciśnięciu buttona wyskakuje wyjątek:
"Project Project1.exe raised exceptoin class EOLEException with message' OLE error 800A03EC'.Process stopped.Use Step or Run to continue."
Gdy dalej kontynuuje wyskakuje oprogramowany komunikat ShowMessage:
"W Twoim komputerze nie jest zainstalowany MS Excel lub aplikacja ta jest uszkodzona albo też przerwałeś(aś) pracę aplikacjii !'"

Wiecie jak to rozwiązać?

W miarę prosto można też utworzyć plik CSV, który Excel rozpoznaje jako "arkusz":
komorka_a1<tabulator>komorka_b1<tabulator>..... itd.<enter>
komorka_a2<tabulator>komorka_b2<tabulator>..... itd.<enter>
Zamiast tabulatora może być przecinek

O wiele prościej i efektywniej jest podłączyć się do pliku Excela
Poprzez ADOConnection (sterownik Microsoft Jet 4) i pokazać dane
w komponencie DBGrid, jak znajdę chwilę czasu to wrzucę do gotowców
gotowy kod