delphi 表格数据导出到excel
2009年03月14日 星期六 下午 02:32
    procedure TfrmMain.xGridDataToExcel(mGrid: TStringGrid; pTitle, SePTitle,
pTail, pStrCols: string);
var
i,j:integer;
strlist:Tstringlist;
str,Filename:string;
h,k:integer;
Excelid: OleVariant;
s: string;
v,sheet,range:variant;
icol,irow:integer;
nCols:integer;
nCurrCol:integer;
nCurrRow:integer;
begin
excelSaveto.Title:='请选择需要导出到的目标文件';
if excelSaveto.Execute = false then exit;
Filename:=trim(excelSaveto.FileName);
nCols := 0;
for j:=0 to mGrid.ColCount - 1 do begin
      if mGrid.ColWidths[j]>0 then nCols := nCols + 1;
end;
if nCols = 0 then begin
      showmessage('没有数据，无法导出!');
      exit;
end;
//导出到excel表格
try
    Excelid := CreateOLEObject('Excel.Application');
except
    Application.MessageBox('Excel没有安装！', '提示信息', MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);
    Exit;
end;
Excelid.Visible := false;
//Excelid.Visible := true;
Excelid.WorkBooks.Add;
//Excelid.WorkBooks[1].WorkSheets[1].Name := pTitle;
Sheet := Excelid.Workbooks[1].WorkSheets[1];
//标题
lls[1, 1] := pTitle;
sheet.lls[1, 1],lls[1,nCols]].Select; //选择该列
Excelid.selection.HorizontalAlignment := $FFFFEFF4;                              //居中
Excelid.selection.MergeCells := True;
//小标题
nCurrRow := 2;
if SePTitle <> '' then begin
    Sheet.Cells[2,1] := SePTitle;
    sheet.lls[2, 1],lls[2,nCols]].Select; //选择该列
    //Excelid.selection.HorizontalAlignment := $FFFFEFF4;                              //居中delphi app
    Excelid.selection.MergeCells := True;
    //表体(包括表头)
    nCurrRow := 3;
end;
for i:=0 to mGrid.RowCount-1 do begin
    nCurrCol := 1;
    for j:=0 to mGrid.ColCount-1 do begin
      if mGrid.ColWidths[j]>0 then begin
        if pos(','+inttostr(j)+',', ','+pStrCols+',')<>0 then begin //导出为字符串格式
          Sheet.Cells[nCurrRow,nCurrCol].NumberFormatLocal := '@';
          Sheet.Cells[nCurrRow,nCurrCol] := mGrid.Cells[j,i];
        end else begin
          Sheet.Cells[nCurrRow,nCurrCol] := mGrid.Cells[j,i];
        end;
        nCurrCol := nCurrCol + 1;
      end;
    end;
    nCurrRow := nCurrRow + 1;
end;
//表尾文字
Sheet.Cells[nCurrRow,1] := pTail;
sheet.lls[nCurrRow, 1],lls[nCurrRow,nCols]].Select; //选择该列
Excelid.selection.HorizontalAlignment := $FFFFEFF4;                              //居中
Excelid.selection.MergeCells := True;
try
    lls[1,1].Select;
    Excelid.Workbooks[1].SaveAs(FileName);
    Excelid.Workbooks[1].close;
    Excelid.Quit;
except
    Excelid.Quit;        //有时写完后立即退出，但写进程还占用着该文件，不允许退出，所以这里再退出一次
end;                  //实际上就是设一点点延迟，
Excelid := Unassigned;
end;
如何把数据库表导出为Excel表格?(用Delphi)
我将演示程序的所有代码贴上，请参考，
一个主窗体From1,一个Table1,一个DataSource1 ,两个BitBtn ，一个DBGrid1.

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Buttons, Grids, DBGrids, DB, DBTables;

type
 TForm1 = class(TForm)
 Table1: TTable;
 DataSource1: TDataSource;
 DBGrid1: TDBGrid;
 BitBtn1: TBitBtn;
 BitBtn2: TBitBtn;
 procedure BitBtn2Click(Sender: TObject);
 procedure FormClose(Sender: TObject; var Action: TCloseAction);
 procedure BitBtn1Click(Sender: TObject);
 procedure ToExcel(DbGrid:TDBGrid; Tab: TTable; ExcelApp:variant); //过程声明
 private
 { Private declarations }
 public
 { Public declarations }
 end;

var
 Form1: TForm1;

implementation
uses ComObj; //加上comobj .
{$R *.dfm}

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
 close;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Application.Terminate;
 Release;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var 
 ExcelApp: variant; 
begin
 if Table1.RecordCount=0 then
 begin
 Application.MessageBox('没有数据可导出。', '提示', MB_OK +
 MB_ICONINFORMATION + MB_DEFBUTTON2);
 Exit;
 end;
 application.ProcessMessages;
 try 
 ExcelApp:=createoleobject('Excel.application'); 
 except 
 messageDlg('请先安装MicroSoft Excel',mtError,[mbok],0); 
 exit; 
 end; 
 ExcelApp.Visible := True; 
 ExcelApp.Caption := '标题：'; 
 ExcelApp.WorkBooks.Add; 
 ExcelApp.WorkSheets[1].Activate; 
 ExcelApp.WorkSheets[1].name:='表名'; 
 ExcelApp.ActiveSheet.Rows[1].Font.Bold:= True; 
 ExcelApp.Columns[1].NumberFormatLocal:='@'; 
 ToExcel(DbGrid1,Table1,ExcelApp); //调用输出过程 。
 Application.MessageBox('恭喜！' + #13#10#13#10 + 
 '数据成功导出，请注意数据备份。', '提示', MB_OK + MB_ICONINFORMATION +
 MB_DEFBUTTON2);
end;

procedure TForm1.ToExcel(DbGrid:TDBGrid; Tab: TTable; ExcelApp:variant);
var
 i,j,FieldNum:integer;
begin
 with Tab do 
 begin
 DisableControls;
 fieldNum := dbgrid.fieldCount;
 for i:=1 to fieldNum do //写表头
 begin
 ExcelApp.Cells[1,i]:=Form1.DBGrid1.Columns[i-1].Title.caption;
 end; 
 first;
 i:=2; 
 while not eof do 
 begin 
 for j:=1 to fieldNum do 
 begin 
 ExcelApp.Cells[i,j]:=fields[j-1].AsString;
 end; 
 inc(i); 
 if (i mod 20)=0 then 
 ExcelApp.Cells[i+10,1].Activate; 
 next; 
 end; 
 EnableControls; 
 end; 
end; 



end.

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。