Delphi 操作Excel方法大全

操作Excel大全

原文地址：http://blog.csdn.net/lailai186/article/details/6664110
Delphi 控制Excel
(一) 使用动态创建的方法
首先创建 Excel 对象，使用ComObj:
var ExcelApp: Variant;
ExcelApp := CreateOleObject( ‘Excel.Application’ );

1. 显示当前窗口：
   ExcelApp.Visible := True;
2. 更改 Excel 标题栏：
   ExcelApp.Caption := ‘应用程序调用 Microsoft Excel’;
3. 添加新工作簿：
   ExcelApp.WorkBooks.Add;
4. 打开已存在的工作簿：
   ExcelApp.WorkBooks.Open( ‘C:/Excel/Demo.xls’ );
5. 设置第2个工作表为活动工作表：
   ExcelApp.WorkSheets[2].Activate; 或 ExcelApp.WorksSheets[ ‘Sheet2’ ].Activate;
6. 给单元格赋值：
   ExcelApp.Cells[1,4].Value := ‘第一行第四列’;
7. 设置指定列的宽度（单位：字符个数），以第一列为例：
   ExcelApp.ActiveSheet.Columns[1].ColumnsWidth := 5;
8. 设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：
   ExcelApp.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米
9. 在第8行之前插入分页符：
   ExcelApp.WorkSheets[1].Rows.PageBreak := 1;
10. 在第8列之前删除分页符：ExcelApp.ActiveSheet.Columns[4].PageBreak := 0;
11. 指定边框线宽度：
    ExcelApp.ActiveSheet.Range[ ‘B3:D4’ ].Borders[2].Weight := 3;
    1-左 2-右 3-顶 4-底 5-斜( / ) 6-斜( / )
12. 清除第一行第四列单元格公式：
    ExcelApp.ActiveSheet.Cells[1,4].ClearContents;
13. 设置第一行字体属性：ExcelApp.ActiveSheet.Rows[1].Font.Name := ‘隶书’;
    ExcelApp.ActiveSheet.Rows[1].Font.Color := clBlue;
    ExcelApp.ActiveSheet.Rows[1].Font.Bold := True;
    ExcelApp.ActiveSheet.Rows[1].Font.UnderLine := True;
14. 进行页面设置：
    a.页眉：
    ExcelApp.ActiveSheet.PageSetup.CenterHeader := ‘报表演示’;
    b.页脚：
    ExcelApp.ActiveSheet.PageSetup.CenterFooter := ‘第&P页’;
    c.页眉到顶端边距2cm：
    ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
    d.页脚到底端边距3cm：
    ExcelApp.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
    e.顶边距2cm：
    ExcelApp.ActiveSheet.PageSetup.TopMargin := 2/0.035;
    f.底边距2cm：
    ExcelApp.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
    g.左边距2cm：
    ExcelApp.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
    h.右边距2cm：
    ExcelApp.ActiveSheet.PageSetup.RightMargin := 2/0.035;
    i.页面水平居中：
    ExcelApp.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
    j.页面垂直居中：
    ExcelApp.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
    k.打印单元格网线：
    ExcelApp.ActiveSheet.PageSetup.PrintGridLines := True;
15. 拷贝操作：
    a.拷贝整个工作表： ExcelApp.ActiveSheet.Used.Range.Copy;
    b.拷贝指定区域： ExcelApp.ActiveSheet.Range[ ‘A1:E2’ ].Copy;
    c.从A1位置开始粘贴： ExcelApp.ActiveSheet.Range.[ ‘A1’ ].PasteSpecial;
    d.从文件尾部开始粘贴： ExcelApp.ActiveSheet.Range.PasteSpecial;
16. 插入一行或一列：
    a. ExcelApp.ActiveSheet.Rows[2].Insert;
    b. ExcelApp.ActiveSheet.Columns[1].Insert;
17. 删除一行或一列：
    a. ExcelApp.ActiveSheet.Rows[2].Delete;
    b. ExcelApp.ActiveSheet.Columns[1].Delete;
18. 打印预览工作表：
    ExcelApp.ActiveSheet.PrintPreview;
19. 打印输出工作表：
    ExcelApp.ActiveSheet.PrintOut;
20. 工作表保存：
    if not ExcelApp.ActiveWorkBook.Saved then
    ExcelApp.ActiveSheet.PrintPreview;
21. 工作表另存为：
    ExcelApp.SaveAs( ‘C:/Excel/Demo1.xls’ );
22. 放弃存盘：
    ExcelApp.ActiveWorkBook.Saved := True;
23. 关闭工作簿：
    ExcelApp.WorkBooks.Close;
24. 退出 Excel：
    ExcelApp.Quit;
    (二) 使用Delphi 控件方法
    在Form中分别放入ExcelApplication, ExcelWorkbook和ExcelWorksheet。
    1） 打开Excel
    ExcelApplication1.Connect;
25. 显示当前窗口：
    ExcelApplication1.Visible[0]:=True;
26. 更改 Excel 标题栏：
    ExcelApplication1.Caption := ‘应用程序调用 Microsoft Excel’;
27. 添加新工作簿：
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,0));
28. 添加新工作表：
    var Temp_Worksheet: _WorkSheet;
    begin
    Temp_Worksheet:=ExcelWorkbook1.
    WorkSheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0) as _WorkSheet;
    ExcelWorkSheet1.ConnectTo(Temp_WorkSheet);End;
29. 打开已存在的工作簿：
    ExcelApplication1.Workbooks.Open (c:/a.xls
    EmptyParam,EmptyParam,EmptyParam,EmptyParam,
    EmptyParam,EmptyParam,EmptyParam,EmptyParam,
    EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)
30. 设置第2个工作表为活动工作表：
    ExcelApplication1.WorkSheets[2].Activate; 或
    ExcelApplication1.WorksSheets[ ‘Sheet2’ ].Activate;
31. 给单元格赋值：
    ExcelApplication1.Cells[1,4].Value := ‘第一行第四列’;
32. 设置指定列的宽度（单位：字符个数），以第一列为例：
    ExcelApplication1.ActiveSheet.Columns[1].ColumnsWidth := 5;
33. 设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：
    ExcelApplication1.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米
34. 在第8行之前插入分页符：
    ExcelApplication1.WorkSheets[1].Rows.PageBreak := 1;
35. 在第8列之前删除分页符：
    ExcelApplication1.ActiveSheet.Columns[4].PageBreak := 0;
36. 指定边框线宽度：
    ExcelApplication1.ActiveSheet.Range[ ‘B3:D4’ ].Borders[2].Weight := 3;
    1-左 2-右 3-顶 4-底 5-斜( / ) 6-斜( / )
37. 清除第一行第四列单元格公式：
    ExcelApplication1.ActiveSheet.Cells[1,4].ClearContents;
38. 设置第一行字体属性：
    ExcelApplication1.ActiveSheet.Rows[1].Font.Name := ‘隶书’;
    ExcelApplication1.ActiveSheet.Rows[1].Font.Color := clBlue;
    ExcelApplication1.ActiveSheet.Rows[1].Font.Bold := True;
    ExcelApplication1.ActiveSheet.Rows[1].Font.UnderLine := True;
39. 进行页面设置：
    a.页眉：
    ExcelApplication1.ActiveSheet.PageSetup.CenterHeader := ‘报表演示’;
    b.页脚：
    ExcelApplication1.ActiveSheet.PageSetup.CenterFooter := ‘第&P页’;
    c.页眉到顶端边距2cm：
    ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;
    d.页脚到底端边距3cm：
    ExcelApplication1.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;
    e.顶边距2cm：
    ExcelApplication1.ActiveSheet.PageSetup.TopMargin := 2/0.035;
    f.底边距2cm：
    ExcelApplication1.ActiveSheet.PageSetup.BottomMargin := 2/0.035;
    g.左边距2cm：
    ExcelApplication1.ActiveSheet.PageSetup.LeftMargin := 2/0.035;
    h.右边距2cm：
    ExcelApplication1.ActiveSheet.PageSetup.RightMargin := 2/0.035;
    i.页面水平居中：
    ExcelApplication1.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;
    j.页面垂直居中：
    ExcelApplication1.ActiveSheet.PageSetup.CenterVertically := 2/0.035;
    k.打印单元格网线：
    ExcelApplication1.ActiveSheet.PageSetup.PrintGridLines := True;
40. 拷贝操作：
    a.拷贝整个工作表：
    ExcelApplication1.ActiveSheet.Used.Range.Copy;
    b.拷贝指定区域：
    ExcelApplication1.ActiveSheet.Range[ ‘A1:E2’ ].Copy;
    c.从A1位置开始粘贴：
    ExcelApplication1.ActiveSheet.Range.[ ‘A1’ ].PasteSpecial;
    d.从文件尾部开始粘贴：
    ExcelApplication1.ActiveSheet.Range.PasteSpecial;
41. 插入一行或一列：
    a. ExcelApplication1.ActiveSheet.Rows[2].Insert;
    b. ExcelApplication1.ActiveSheet.Columns[1].Insert;
42. 删除一行或一列：
    a. ExcelApplication1.ActiveSheet.Rows[2].Delete;
    b. ExcelApplication1.ActiveSheet.Columns[1].Delete;
43. 打印预览工作表：
    ExcelApplication1.ActiveSheet.PrintPreview;
44. 打印输出工作表：
    ExcelApplication1.ActiveSheet.PrintOut;
45. 工作表保存：
    if not ExcelApplication1.ActiveWorkBook.Saved then
    ExcelApplication1.ActiveSheet.PrintPreview;
46. 工作表另存为：
    ExcelApplication1.SaveAs( ‘C:/Excel/Demo1.xls’ );
47. 放弃存盘：
    ExcelApplication1.ActiveWorkBook.Saved := True;
48. 关闭工作簿：
    ExcelApplication1.WorkBooks.Close;
49. 退出 Excel：
    ExcelApplication1.Quit;
    ExcelApplication1.Disconnect;
    本人 收藏

对不起我还需要一个锁定功能啊，就是输出到EXCEL后只能看，不能进行手工修改

Xl.Cells.Select;//Select All Cells
Xl.Selection.Locked = True;// Lock Selected Cells

//Xl:=CreateOleObject(‘Excel.Application’);

procedure TForm1.BitBtn4Click(Sender: TObject);
var
ExcelApp, Sheet: Variant;
begin
if OpenDialog1.Execute then
begin
ExcelApp := CreateOleObject( ‘Excel.Application’ );
ExcelApp.Workbooks.Open(OpenDialog1.FileName);
Sheet := ExcelApp.ActiveSheet;
Caption := 'Row Count: ’ + IntToStr(Sheet.UsedRange.Rows.Count);
ExcelApp.Quit;
Sheet := Unassigned;
ExcelApp := Unassigned;
end;
end;

procedure CopyDbDataToExcel(Target: TDbgrid);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
begin
Screen.Cursor := crHourGlass;
if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;
//通过ole创建Excel对象
try
XLApp := CreateOleObject(‘Excel.Application’);
except
Screen.Cursor := crDefault;
Exit;
end;
XLApp.WorkBooks.Add[XLWBatWorksheet];
XLApp.WorkBooks[1].WorkSheets[1].Name := ‘测试工作薄’;
Sheet := XLApp.Workbooks[1].WorkSheets[‘测试工作薄’];
if not Target.DataSource.DataSet.Active then
begin
Screen.Cursor := crDefault;
Exit;
end;
Target.DataSource.DataSet.first;

for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[1, iCount + 1] := Target.Columns.Items[iCount].Title.Caption;
end;
jCount := 1;
while not Target.DataSource.DataSet.Eof do
begin
for iCount := 0 to Target.Columns.Count - 1 do
begin
Sheet.cells[jCount + 1, iCount + 1] := Target.Columns.Items[iCount].Field.AsString;
end;
Inc(jCount);
Target.DataSource.DataSet.Next;
end;
XlApp.Visible := True;
Screen.Cursor := crDefault;
end;

看看我的函数
function ExportToExcel(Header: String;
vDataSet: TDataSet): Boolean;
var
I,VL_I,j: integer;
S,SysPath: string;
MsExcel:Variant;
begin
Result:=true;
if Application.MessageBox(‘您确信将数据导入到Excel吗?’,‘提示！’,MB_OKCANCEL + MB_DEFBUTTON1) = IDOK then
begin
SysPath:=ExtractFilePath(application.exename);
with TStringList.Create do
try
vDataSet.First ;
S:=S+Header;
// system.Delete(s,1,1);
add(s);
s:=’;
For I:=0 to vDataSet.fieldcount-1 do
begin
If vDataSet.fields[I].visible=true then
S:=S+#9+vDataSet.fields[I].displaylabel;
end;
system.Delete(s,1,1);
add(s);
while not vDataSet.Eof do
begin
S := ‘;
for I := 0 to vDataSet.FieldCount -1 do
begin
If vDataSet.fields[I].visible=true then
S := S + #9 + vDataSet.Fields[I].AsString;
end;
System.Delete(S, 1, 1);
Add(S);
vDataSet.Next;
end;
Try
SaveToFile(SysPath+’/Tem.xls’);
Except
ShowMessage(‘写文件时发生保护性错误，Excel 如在运行，请先关闭！’);
Result:=false;
exit;
end;
finally
Free;
end;
Try
MSExcel:=CreateOleObject(‘Excel.Application’);
Except
ShowMessage(‘Excel 没有安装，请先安装！’);
Result:=false;
exit;
end;
Try
MSExcel.workbooks.open(SysPath+’/Tem.xls’);
Except
ShowMessage(‘打开临时文件时出错，请检查’+SysPath+’/Tem.xls’);
Result:=false;
exit;
end;
MSExcel.visible:=True;
for VL_I :=1 to 4 do
MSExcel.Selection.Borders[VL_I].LineStyle := 0;
MSExcel.cells.select;
MSExcel.Selection.HorizontalAlignment :=3;
MSExcel.Selection.Borders[1].LineStyle := 0;

  MSExcel.Range['A1'].Select;
  MSExcel.Selection.Font.Size :=24;

  J:=0 ;
  for i:=0 to vdataset.fieldcount-1 do
      if vDataSet.fields[I].visible  then
         J:=J+1;

  VL_I :=J;
  MSExcel.Range['A1:'+F_ColumnName(VL_I)+'1'].Select;
  MSExcel.Range['A1:'+F_ColumnName(VL_I)+'1'].Merge;

• 1
• 2
• 3
• 4
• 5
• 6
• 7
• 8
• 9
• 10
• 11

end
else
Result:=false;
end;

转别人的组件
unit OleExcel;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
comobj, DBTables, Grids;
type
TOLEExcel = class(TComponent)
private
FExcelCreated: Boolean;
FVisible: Boolean;
FExcel: Variant;
FWorkBook: Variant;
FWorkSheet: Variant;
FCellFont: TFont;
FTitleFont: TFont;
FFontChanged: Boolean;
FIgnoreFont: Boolean;
FFileName: TFileName;
procedure SetExcelCellFont(var Cell: Variant);
procedure SetExcelTitleFont(var Cell: Variant);
procedure GetTableColumnName(const Table: TTable; var Cell: Variant);
procedure GetQueryColumnName(const Query: TQuery; var Cell: Variant);
procedure GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
procedure GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
procedure GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
protected
procedure SetCellFont(NewFont: TFont);
procedure SetTitleFont(NewFont: TFont);
procedure SetVisible(DoShow: Boolean);
function GetCell(ACol, ARow: Integer): string;
procedure SetCell(ACol, ARow: Integer; const Value: string);

function GetDateCell(ACol, ARow: Integer): TDateTime;
procedure SetDateCell(ACol, ARow: Integer; const Value: TDateTime);

• 1
• 2

public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CreateExcelInstance;
property Cell[ACol, ARow: Integer]: string read GetCell write SetCell;
property DateCell[ACol, ARow: Integer]: TDateTime read GetDateCell write SetDateCell;
function IsCreated: Boolean;
procedure TableToExcel(const Table: TTable);
procedure QueryToExcel(const Query: TQuery);
procedure StringGridToExcel(const StringGrid: TStringGrid);
procedure SaveToExcel(const FileName: string);
published
property TitleFont: TFont read FTitleFont write SetTitleFont;
property CellFont: TFont read FCellFont write SetCellFont;
property Visible: Boolean read FVisible write SetVisible;
property IgnoreFont: Boolean read FIgnoreFont write FIgnoreFont;
property FileName: TFileName read FFileName write FFileName;
end;

procedure Register;

implementation

constructor TOLEExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIgnoreFont := True;
FCellFont := TFont.Create;
FTitleFont := TFont.Create;
FExcelCreated := False;
FVisible := False;
FFontChanged := False;
end;

destructor TOLEExcel.Destroy;
begin
FCellFont.Free;
FTitleFont.Free;
inherited Destroy;
end;

procedure TOLEExcel.SetExcelCellFont(var Cell: Variant);
begin
if FIgnoreFont then exit;
with FCellFont do
begin
Cell.Font.Name := Name;
Cell.Font.Size := Size;
Cell.Font.Color := Color;
Cell.Font.Bold := fsBold in Style;
Cell.Font.Italic := fsItalic in Style;
Cell.Font.UnderLine := fsUnderline in Style;
Cell.Font.Strikethrough := fsStrikeout in Style;
end;
end;

procedure TOLEExcel.SetExcelTitleFont(var Cell: Variant);
begin
if FIgnoreFont then exit;
with FTitleFont do
begin
Cell.Font.Name := Name;
Cell.Font.Size := Size;
Cell.Font.Color := Color;
Cell.Font.Bold := fsBold in Style;
Cell.Font.Italic := fsItalic in Style;
Cell.Font.UnderLine := fsUnderline in Style;
Cell.Font.Strikethrough := fsStrikeout in Style;
end;
end;

procedure TOLEExcel.SetVisible(DoShow: Boolean);
begin
if not FExcelCreated then exit;
if DoShow then
FExcel.Visible := True
else
FExcel.Visible := False;
end;

function TOLEExcel.GetCell(ACol, ARow: Integer): string;
begin
if not FExcelCreated then exit;
result := FWorkSheet.Cells[ARow, ACol];
end;

procedure TOLEExcel.SetCell(ACol, ARow: Integer; const Value: string);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
Cell := FWorkSheet.Cells[ARow, ACol];
SetExcelCellFont(Cell);
Cell.Value := Value;
end;

function TOLEExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
begin
if not FExcelCreated then
begin
result := 0;
exit;
end;
result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end;

procedure TOLEExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
Cell := FWorkSheet.Cells[ARow, ACol];
SetExcelCellFont(Cell);
Cell.Value := ‘’ + DateTimeToStr(Value);
end;

procedure TOLEExcel.CreateExcelInstance;
begin
try
FExcel := CreateOLEObject(‘Excel.Application’);
FWorkBook := FExcel.WorkBooks.Add;
FWorkSheet := FWorkBook.WorkSheets.Add;
FExcelCreated := True;
except
FExcelCreated := False;
end;
end;

function TOLEExcel.IsCreated: Boolean;
begin
result := FExcelCreated;
end;

procedure TOLEExcel.SetTitleFont(NewFont: TFont);
begin
if NewFont <> FTitleFont then
FTitleFont.Assign(NewFont);
end;

procedure TOLEExcel.SetCellFont(NewFont: TFont);
begin
if NewFont <> FCellFont then
FCellFont.Assign(NewFont);
end;

procedure TOLEExcel.GetTableColumnName(const Table: TTable; var Cell: Variant);
var
Col: integer;
begin
for Col := 0 to Table.FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[1, Col + 1];
SetExcelTitleFont(Cell);
Cell.Value := Table.Fields[Col].FieldName;
end;
end;

procedure TOLEExcel.TableToExcel(const Table: TTable);
var
Col, Row: LongInt;
Cell: Variant;
begin
if not FExcelCreated then exit;
if Table.Active = False then exit;

GetTableColumnName(Table, Cell);
Row := 2;
with Table do
begin
first;
while not EOF do
begin
for Col := 0 to FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[Row, Col + 1];
SetExcelCellFont(Cell);
Cell.Value := Fields[Col].AsString;
end;
next;
Inc(Row);
end;
end;
end;

procedure TOLEExcel.GetQueryColumnName(const Query: TQuery; var Cell: Variant);
var
Col: integer;
begin
for Col := 0 to Query.FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[1, Col + 1];
SetExcelTitleFont(Cell);
Cell.Value := Query.Fields[Col].FieldName;
end;
end;

procedure TOLEExcel.QueryToExcel(const Query: TQuery);
var
Col, Row: LongInt;
Cell: Variant;
begin
if not FExcelCreated then exit;
if Query.Active = False then exit;

GetQueryColumnName(Query, Cell);
Row := 2;
with Query do
begin
first;
while not EOF do
begin
for Col := 0 to FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[Row, Col + 1];
SetExcelCellFont(Cell);
Cell.Value := Fields[Col].AsString;
end;
next;
Inc(Row);
end;
end;
end;

procedure TOLEExcel.GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row: LongInt;
begin
for Col := 0 to StringGrid.FixedCols - 1 do
for Row := 0 to StringGrid.RowCount - 1 do
begin
Cell := FWorkSheet.Cells[Row + 1, Col + 1];
SetExcelTitleFont(Cell);
Cell.Value := StringGrid.Cells[Col, Row];
end;
end;

procedure TOLEExcel.GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row: LongInt;
begin
for Row := 0 to StringGrid.FixedRows - 1 do
for Col := 0 to StringGrid.ColCount - 1 do
begin
Cell := FWorkSheet.Cells[Row + 1, Col + 1];
SetExcelTitleFont(Cell);
Cell.Value := StringGrid.Cells[Col, Row];
end;
end;

procedure TOLEExcel.GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
var
Col, Row, x, y: LongInt;
begin
Col := StringGrid.FixedCols;
Row := StringGrid.FixedRows;
for x := Row to StringGrid.RowCount - 1 do
for y := Col to StringGrid.ColCount - 1 do
begin
Cell := FWorkSheet.Cells[x + 1, y + 1];
SetExcelCellFont(Cell);
Cell.Value := StringGrid.Cells[y, x];
end;
end;

procedure TOLEExcel.StringGridToExcel(const StringGrid: TStringGrid);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
GetFixedCols(StringGrid, Cell);
GetFixedRows(StringGrid, Cell);
GetStringGridBody(StringGrid, Cell);
end;

procedure TOLEExcel.SaveToExcel(const FileName: string);
begin
if not FExcelCreated then exit;
FWorkSheet.SaveAs(FileName);
end;

procedure Register;
begin
RegisterComponents(‘Tanglu’, [TOLEExcel]);
end;

end.

根据别人的组件改写的支持ADO

unit AdoToOleExcel;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
comobj, DBTables, Grids,ADODB;
type
TAdoToOleExcel = class(TComponent)
private
FExcelCreated: Boolean;
FVisible: Boolean;
FExcel: Variant;
FWorkBook: Variant;
FWorkSheet: Variant;
FCellFont: TFont;
FTitleFont: TFont;
FFontChanged: Boolean;
FIgnoreFont: Boolean;
FFileName: TFileName;
procedure SetExcelCellFont(var Cell: Variant);
procedure SetExcelTitleFont(var Cell: Variant);
procedure GetTableColumnName(const AdoTable: TAdoTable; var Cell: Variant);
procedure GetQueryColumnName(const AdoQuery: TAdoQuery; var Cell: Variant);
procedure GetFixedCols(const StringGrid: TStringGrid; var Cell: Variant);
procedure GetFixedRows(const StringGrid: TStringGrid; var Cell: Variant);
procedure GetStringGridBody(const StringGrid: TStringGrid; var Cell: Variant);
protected
procedure SetCellFont(NewFont: TFont);
procedure SetTitleFont(NewFont: TFont);
procedure SetVisible(DoShow: Boolean);
function GetCell(ACol, ARow: Integer): string;
procedure SetCell(ACol, ARow: Integer; const Value: string);

function GetDateCell(ACol, ARow: Integer): TDateTime;
procedure SetDateCell(ACol, ARow: Integer; const Value: TDateTime);

• 1
• 2

public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CreateExcelInstance;
property Cell[ACol, ARow: Integer]: string read GetCell write SetCell;
property DateCell[ACol, ARow: Integer]: TDateTime read GetDateCell write SetDateCell;
function IsCreated: Boolean;
procedure ADOTableToExcel(const ADOTable: TADOTable);
procedure ADOQueryToExcel(const ADOQuery: TADOQuery);
procedure StringGridToExcel(const StringGrid: TStringGrid);
procedure SaveToExcel(const FileName: string);
published
property TitleFont: TFont read FTitleFont write SetTitleFont;
property CellFont: TFont read FCellFont write SetCellFont;
property Visible: Boolean read FVisible write SetVisible;
property IgnoreFont: Boolean read FIgnoreFont write FIgnoreFont;
property FileName: TFileName read FFileName write FFileName;
end;

procedure Register;

implementation

constructor TAdoToOleExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIgnoreFont := True;
FCellFont := TFont.Create;
FTitleFont := TFont.Create;
FExcelCreated := False;
FVisible := False;
FFontChanged := False;
end;

destructor TAdoToOleExcel.Destroy;
begin
FCellFont.Free;
FTitleFont.Free;
inherited Destroy;
end;

procedure TAdoToOleExcel.SetExcelCellFont(var Cell: Variant);
begin
if FIgnoreFont then exit;
with FCellFont do
begin
Cell.Font.Name := Name;
Cell.Font.Size := Size;
Cell.Font.Color := Color;
Cell.Font.Bold := fsBold in Style;
Cell.Font.Italic := fsItalic in Style;
Cell.Font.UnderLine := fsUnderline in Style;
Cell.Font.Strikethrough := fsStrikeout in Style;
end;
end;

procedure TAdoToOleExcel.SetExcelTitleFont(var Cell: Variant);
begin
if FIgnoreFont then exit;
with FTitleFont do
begin
Cell.Font.Name := Name;
Cell.Font.Size := Size;
Cell.Font.Color := Color;
Cell.Font.Bold := fsBold in Style;
Cell.Font.Italic := fsItalic in Style;
Cell.Font.UnderLine := fsUnderline in Style;
Cell.Font.Strikethrough := fsStrikeout in Style;
end;
end;

procedure TAdoToOleExcel.SetVisible(DoShow: Boolean);
begin
if not FExcelCreated then exit;
if DoShow then
FExcel.Visible := True
else
FExcel.Visible := False;
end;

function TAdoToOleExcel.GetCell(ACol, ARow: Integer): string;
begin
if not FExcelCreated then exit;
result := FWorkSheet.Cells[ARow, ACol];
end;

procedure TAdoToOleExcel.SetCell(ACol, ARow: Integer; const Value: string);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
Cell := FWorkSheet.Cells[ARow, ACol];
SetExcelCellFont(Cell);
Cell.Value := Value;
end;

function TAdoToOleExcel.GetDateCell(ACol, ARow: Integer): TDateTime;
begin
if not FExcelCreated then
begin
result := 0;
exit;
end;
result := StrToDateTime(FWorkSheet.Cells[ARow, ACol]);
end;

procedure TAdoToOleExcel.SetDateCell(ACol, ARow: Integer; const Value: TDateTime);
var
Cell: Variant;
begin
if not FExcelCreated then exit;
Cell := FWorkSheet.Cells[ARow, ACol];
SetExcelCellFont(Cell);
Cell.Value := ‘’ + DateTimeToStr(Value);
end;

procedure TAdoToOleExcel.CreateExcelInstance;
begin
try
FExcel := CreateOLEObject(‘Excel.Application’);
FWorkBook := FExcel.WorkBooks.Add;
FWorkSheet := FWorkBook.WorkSheets.Add;
FExcelCreated := True;
except
FExcelCreated := False;
end;
end;

function TAdoToOleExcel.IsCreated: Boolean;
begin
result := FExcelCreated;
end;

procedure TAdoToOleExcel.SetTitleFont(NewFont: TFont);
begin
if NewFont <> FTitleFont then
FTitleFont.Assign(NewFont);
end;

procedure TAdoToOleExcel.SetCellFont(NewFont: TFont);
begin
if NewFont <> FCellFont then
FCellFont.Assign(NewFont);
end;

procedure TAdoToOleExcel.GetTableColumnName(const ADOTable: TADOTable; var Cell: Variant);
var
Col: integer;
begin
for Col := 0 to ADOTable.FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[1, Col + 1];
SetExcelTitleFont(Cell);
Cell.Value := ADOTable.Fields[Col].FieldName;
end;
end;

procedure TAdoToOleExcel.ADOTableToExcel(const ADOTable: TADOTable);
var
Col, Row: LongInt;
Cell: Variant;
begin
if not FExcelCreated then exit;
if ADOTable.Active = False then exit;

GetTableColumnName(ADOTable, Cell);
Row := 2;
with ADOTable do
begin
first;
while not EOF do
begin
for Col := 0 to FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[Row, Col + 1];
SetExcelCellFont(Cell);
Cell.Value := Fields[Col].AsString;
end;
next;
Inc(Row);
end;
end;
end;

procedure TAdoToOleExcel.GetQueryColumnName(const ADOQuery: TADOQuery; var Cell: Variant);
var
Col: integer;
begin
for Col := 0 to ADOQuery.FieldCount - 1 do
begin
Cell := FWorkSheet.Cells[1, Col + 1];
SetExcelTitleFont(Cell);
Cell.Value := ADOQuery.Fields[Col].FieldName;
end;
end;

procedure TAdoToOleExcel.ADOQueryToExcel(const ADOQuery: TADOQuery);
var
Col, Row: LongInt;
Cell: Variant;
begin
if not FExcelCreated then exit;
if ADOQuery.Active = False then exit;

GetQueryColumnName(ADOQuery, Cell);
Row := 2;
with ADOQuery do