Delphi Excel 操作大全

2024-04-10 01:23•javascript•阅读 1934

(一) 使用动态创建的方法

首先创建 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;

2) 显示当前窗口：

ExcelApplication1.Visible[0]:=True;

3) 更改 Excel 标题栏：

ExcelApplication1.Caption := '应用程序调用 Microsoft Excel';

4) 添加新工作簿：

ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks.Add(EmptyParam,0));

5) 添加新工作表：

var Temp_Worksheet: _WorkSheet;

begin

Temp_Worksheet:=ExcelWorkbook1.

WorkSheets.Add(EmptyParam,EmptyParam,EmptyParam,EmptyParam,0) as _WorkSheet;

ExcelWorkSheet1.ConnectTo(Temp_WorkSheet);End;

6) 打开已存在的工作簿：

ExcelApplication1.Workbooks.Open (c:/a.xls

EmptyParam,EmptyParam,EmptyParam,EmptyParam,

EmptyParam,EmptyParam,EmptyParam,EmptyParam,0)

7) 设置第2个工作表为活动工作表：

ExcelApplication1.WorkSheets[2].Activate; 或

ExcelApplication1.WorksSheets[ 'Sheet2' ].Activate;

8) 给单元格赋值：

ExcelApplication1.Cells[1,4].Value := '第一行第四列';

9) 设置指定列的宽度（单位：字符个数），以第一列为例：

ExcelApplication1.ActiveSheet.Columns[1].ColumnsWidth := 5;

10) 设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：

ExcelApplication1.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米

11) 在第8行之前插入分页符：

ExcelApplication1.WorkSheets[1].Rows.PageBreak := 1;

12) 在第8列之前删除分页符：

ExcelApplication1.ActiveSheet.Columns[4].PageBreak := 0;

13) 指定边框线宽度：

ExcelApplication1.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;

1-左 2-右 3-顶 4-底 5-斜( / ) 6-斜( / )

14) 清除第一行第四列单元格公式：

ExcelApplication1.ActiveSheet.Cells[1,4].ClearContents;

15) 设置第一行字体属性：

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;

16) 进行页面设置：

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;

17) 拷贝操作：

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;

18) 插入一行或一列：

a. ExcelApplication1.ActiveSheet.Rows[2].Insert;

b. ExcelApplication1.ActiveSheet.Columns[1].Insert;

19) 删除一行或一列：

a. ExcelApplication1.ActiveSheet.Rows[2].Delete;

b. ExcelApplication1.ActiveSheet.Columns[1].Delete;

20) 打印预览工作表：

ExcelApplication1.ActiveSheet.PrintPreview;

21) 打印输出工作表：

ExcelApplication1.ActiveSheet.PrintOut;

22) 工作表保存：

if not ExcelApplication1.ActiveWorkBook.Saved then

ExcelApplication1.ActiveSheet.PrintPreview;

23) 工作表另存为：

ExcelApplication1.SaveAs( 'C:/Excel/Demo1.xls' );

24) 放弃存盘：

ExcelApplication1.ActiveWorkBook.Saved := True;

25) 关闭工作簿：

ExcelApplication1.WorkBooks.Close;

26) 退出 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;

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;

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);

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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);

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;

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;

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;

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;

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;

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;

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

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;

procedure TAdoToOleExcel.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;

procedure TAdoToOleExcel.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;

procedure TAdoToOleExcel.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;

procedure TAdoToOleExcel.StringGridToExcel(const StringGrid: TStringGrid);

var

Cell: Variant;

begin

if not FExcelCreated then exit;

GetFixedCols(StringGrid, Cell);

GetFixedRows(StringGrid, Cell);

GetStringGridBody(StringGrid, Cell);

end;

procedure TAdoToOleExcel.SaveToExcel(const FileName: string);

begin

if not FExcelCreated then exit;

FWorkSheet.SaveAs(FileName);

end;

procedure Register;

begin

RegisterComponents('Freeman', [TAdoToOleExcel]);

end;

end.

数据导出为Excel格式

首先要创建一个公共单元，名字你们可以随便起。

以下是我创建的公共单元的全部代码：

unit UnitDatatoExcel;

interface

uses

Windows,Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,

DB, ComObj;

type

TKHTMLFormatCellEvent = procedure(Sender: TObject; CellRow,CellColumn: Integer; FieldName: string;

var CustomAttrs, CellData: string) of object;

TDataSetToExcel = class(TComponent)

private

FDataSet: TDataSet;

FOnFormatCell: TKHTMLFormatCellEvent;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure Transfer(const FileName: string; Title: string = ');

published

property DataSet: TDataSet read FDataSet write FDataSet;

end;

implementation

constructor TDataSetToExcel.Create(AOwner: TComponent);

begin

inherited Create(AOwner);

FDataSet := nil;

end;

destructor TDataSetToExcel.Destroy;

begin

inherited;

end;

procedure TDataSetToExcel.Transfer(const FileName:string;Title:string = ');

var

ExcelApp, MyWorkBook: Variant;

i: byte;

j, a: integer;

s, k, b, CustomAttrs: string;

begin

try

ExcelApp := CreateOleObject('Excel.Application');

MyWorkBook := CreateOleObject('Excel.Sheet');

except

on Exception do raise exception.Create('无法打开Excel文件，请确认已经安装Execl')

end;

MyWorkBook := ExcelApp.WorkBooks.Add;

MyWorkBook.WorkSheets[1].Range['A1:D1'].Merge(True);

MyWorkBook.WorkSheets[1].Range['A1:D2'].HorizontalAlignment := $FFFFEFF4;

MyWorkBook.WorkSheets[1].Cells[1, 1].Value := Title;

with FDataSet do

begin

i := 2;

for j := 0 to FieldCount - 1 do

begin

if Fields[j].Visible then

begin

b := Fields[j].DisplayLabel;

CustomAttrs := ';

if Assigned(FOnFormatCell) then

FOnFormatCell(Self, 1, i,

Fields[j].FieldName, CustomAttrs, b);

MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := b;

end;

i := 3;

Close;

Open;

First;

a := 2;

while not Eof do

begin

for j := 0 to FieldCount - 1 do

begin

if Fields[j].Visible then

begin

CustomAttrs := ';

k := Fields[j].Text;

if Assigned(FOnFormatCell) then

FOnFormatCell(Self, i, a,

Fields[j].FieldName, CustomAttrs, k);

MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := k;

inc(a);

end;

Inc(i);

Next;

end;

s := 'A3:D' + IntToStr(i - 1);

s := 'A1:D' + IntToStr(i - 1);

MyWorkBook.WorkSheets[1].Columns[1].ColumnWidth := 20;

MyWorkBook.WorkSheets[1].Columns[4].ColumnWidth := 25;

MyWorkBook.WorkSheets[1].Rows[1].RowHeight := 50;

MyWorkBook.WorkSheets[1].Rows[1].VerticalAlignMent := $FFFFEFF4;

MyWorkBook.WorkSheets[1].Range[s].Font.Name := '仿宋';

s := 'A2:D' + IntToStr(i - 1);

MyWorkBook.WorkSheets[1].Range[s].Borders.LineStyle := 1;

MyWorkBook.WorkSheets[1].PageSetup.CenterHorizontally := True;

MyWorkBook.WorkSheets[1].PageSetup.PrintTitleRows := 'A1';

try

MyWorkBook.Saveas(FileName);

MyWorkBook.Close;

except

MyWorkBook.Close;

end;

ExcelApp.Quit;

ExcelApp := UnAssigned;

end;

end.

然后在调用它的单元里引用它就行了。

下面是调用它的代码：

procedure ToGetherExcel(NewData: TDataSet; NewString: string);

var

DataExcel: TDataSetToExcel;

saveDlg: TSaveDialog;

begin

saveDlg := TSaveDialog.Create(nil); //创建一个存储对话框

DataExcel := TDataSetToExcel.Create(nil);

try

saveDlg.Filter := 'Execl 文件(*.XLS)|*.XLS';

saveDlg.DefaultExt := 'XLS';

saveDlg.FileName := NewString;

if saveDlg.Execute then

begin

DataExcel.DataSet := NewData; //连接的数据集

DataExcel.DataSet.DisableControls;

DataExcel.Transfer(saveDlg.FileName, NewString);

DataExcel.DataSet.EnableControls;

AlterMesg('导出完毕', '提示信息');

end;

finally

saveDlg.Free;

DataExcel.Free;

end;

如果谁还有比着更好的办法，请告诉我，咱们共同进步：）

我给大伙发一个吧,调用过程，很方便,

这里DBGrid可更改为Query等与数据库相关的

procedure DBTOExcel(sDBGrid: DBGrid; Title,Fn: string);

//uses ComObj;

//sDBGrid:数据源

//Title:标题

//Fn:保存文件

var

ExcelApp: Variant;

i,j,k: Integer;

__ColStr,__s:String;

begin

try

ExcelApp := CreateOleObject('Excel.Application');

except

//on Exception do raise exception.Create('无法创建Xls文件，请确认是否安装EXCEL');

application.MessageBox('系统中的MS Excel软件没有安装或安装不正确！', '错误', MB_ICONERROR + MB_OK);

exit;

end;

ExcelApp.visible := False;

ExcelApp.WorkBooks.Add;

ExcelApp.caption := Title;

__ColStr:=Chr(65+sDBGrid.FieldCount-1);

ExcelApp.worksheets[1].range['A1:'+__ColStr+'1'].Merge(True);

//写入标题行

ExcelApp.Cells[1, 1].Value := Title;

ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].HorizontalAlignment := $FFFFEFF4;

ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].VerticalAlignment := $FFFFEFF4;

ExcelApp.worksheets[1].range['A2:B2'].Merge(True);

ExcelApp.worksheets[1].range['C2:D2'].Merge(True);

ExcelApp.Cells[2, 1].Value := '制表人：'+Myvalue.FUserName;

ExcelApp.Cells[2, 3].Value := '制表日期：'+DateToStr(Date());

for i := 1 to sDBGrid.FieldCount do begin

//各个字段的宽度

ExcelApp.worksheets[1].Columns[i].ColumnWidth:=sDBGrid.Fields[i-1].DisplayWidth;

//字段标题

ExcelApp.Cells[3, i].Value := sDBGrid.Columns[i-1].Title.caption;

end;

ExcelApp.worksheets[1].Range['A1:'+__ColStr+'1'].Font.Name := '黑体';

ExcelApp.worksheets[1].Range['A1:'+__ColStr+'1'].Font.Size := 16;

ExcelApp.worksheets[1].range['A1:'+__ColStr+'3'].font.bold:=true;

ExcelApp.worksheets[1].Range['A2:'+__ColStr+'3'].Font.Size := 10;

i := 4;

k := 0;

sDBGrid.DataSource.DataSet.First;

while not sDBGrid.DataSource.DataSet.Eof do begin

for j := 0 to sDBGrid.FieldCount - 1 do begin

ExcelApp.Cells[i, j + 1].Value := sDBGrid.Fields[j].AsString;

end;

sDBGrid.DataSource.DataSet.Next;

i := i + 1;

k:=k+1;

__s:= 'A3:'+__ColStr+IntToStr(i-1);

end;

sDBGrid.DataSource.DataSet.First;

ExcelApp.worksheets[1].Range[__s].HorizontalAlignment := $FFFFEFF4;

ExcelApp.worksheets[1].Range[__s].VerticalAlignment := $FFFFEFF4;

ExcelApp.worksheets[1].Range[__s].Font.Name := '宋体';

ExcelApp.worksheets[1].Range[__s].Font.Size := 10;

ExcelApp.worksheets[1].Range[__s].Borders.LineStyle := 1;

ExcelApp.ActiveSheet.PageSetup.RightMargin := 0.5/0.035;

ExcelApp.ActiveSheet.PageSetup.LeftMargin := 2/0.035;

ExcelApp.ActiveSheet.PageSetup.BottomMargin := 0.5/0.035;

ExcelApp.visible := True;

ExcelApp.ActiveCell.Cells.Select;

ExcelApp.Selection.Columns.AutoFit;

try

ExcelApp.ActiveWorkBook.SaveAs(Fn);

except

end;

//导出数据到Excel

procedure ToExcel(DBGrid:TDBGrid);

var

ExcelApp: Variant;

i,j,k:integer;

FileName:string;

DlgSave:TsaveDialog;

Begin

DlgSave:=TsaveDialog.Create(nil);

DlgSave.Filter:='*.xls|*.xls';

if DlgSave.Execute then

Begin

application.ProcessMessages;

Filename:=DlgSave.FileName;

ExcelApp := CreateOleObject( 'Excel.Application' );

ExcelApp.Caption :='能创监控系统日志数据';//'Microsoft Excel';

ExcelApp.WorkBooks.Add;

application.ProcessMessages;

ExcelApp.WorkSheets[1].Activate;

K:=1;

For i:=0 To DBGrid.Columns.Count-1 Do

Begin

if DBGrid.Columns[i].Visible Then

Begin

ExcelApp.Cells[1,K]:=DBGrid.Columns[i].Title.Caption;

k:=k+1;

End;{if}

End;{for}

ExcelApp.rows[1].font.name:='宋体';

ExcelApp.rows[1].font.size:=10;

ExcelApp.rows[1].Font.Color:=clBlack;

ExcelApp.rows[1].Font.Bold:=true;

j:=1;

For i:=0 To DBGrid.Columns.Count-1 Do

Begin

If DBGrid.Columns[i].Visible Then

Begin

ADOQuery_DB.First;

for k:=1 To ADOQuery_DB.RecordCount-1 Do

Begin

ExcelApp.Cells[K+1,j]:=ADOQuery_DB.FieldByName(DBGrid.Columns[i].FieldName).Asstring;

ADOQuery_DB.Next;

End;{for}

j:=j+1;

End;{if}

End;{for}

For I:=1 To ADOQuery_DB.recordcount Do

ExcelApp.rows[i].Font.SIZE:=9;

ExcelApp.Columns.AutoFit;

ExcelApp.ActiveWorkBook.SaveAs(FileName);

ExcelApp.WorkBooks.Close;

Application.MessageBox('数据导出成功....','数据导出',0);

ExcelApp.Quit;

ExcelApp:=Unassigned;

DlgSave.Destroy;

End;

end;

测试通过！

我可以发一段给你

先在程序上放上三个控件，TExcelApplication，TExcelWorkbook，TExcelWorkSheet，它们都在Server组件板上。

要控制Excel，就是采用自动化编程。以Excel作为自动化服务器。

首先，建立与自动化服务器的连接：

Excelapplication1.Connect;

Excelapplication1.Visible[0]:=true;

Excelapplication1.Caption:='你要的标题';

ExcelWorkbook1.ConnectTo(Excelapplication1.Workbooks.Add(null,0) );

Excelworksheet1.ConnectTo(Excelworkbook1.Worksheets[0] as _worksheet) ;

然后就可以对Excel进行控件了：

从数据库导入数据：

Excel.cells.item[row,col]:=table1.field[i].value;

....

最后不要忘了断开连接

Excelapplication1.disconnect;

Excelapplication1.quit;

至今是delphi菜鸟

******************************************************************

如何把在dbgrid的指定几列导到excel表里?

我的做法:用listbox1显示dbgrid的所用供选择列,listbox2用来显示要导出的列:

procedure TForm1.FormCreate(Sender: TObject);

begin

if kadaoTable1.Active then

kadaoTable1.GetFieldNames(Listbox1.Items);

end;

procedure TForm1.addbitbtnClick(Sender: TObject);//选择字段

begin

try

if listbox1.Items.Count=0 then exit;

if listbox1.Selected[listbox1.ItemIndex] then

begin

Listbox2.Items.Add(Listbox1.Items[Listbox1.ItemIndex]);

Listbox1.Items.Delete(Listbox1.ItemIndex);

if Listbox2.Items.Count>=1 then

DeleteBitBtn.Enabled:=True;

end;

except

showmessage('你没有选择相应字段!');

end;

procedure TForm1.DeleteBitBtnClick(Sender: TObject);//撤消选择

begin

try

if Listbox2.Items.Count=0 then exit;

if listbox2.Selected[Listbox2.ItemIndex] then

begin

Listbox1.Items.Add(Listbox2.items[Listbox2.itemindex]);

Listbox2.Items.Delete(Listbox2.itemindex);

end;

if Listbox2.Items.Count=0 then

DeleteBitBtn.Enabled:=False;

except

showmessage('你没有选择相应字段!');

end;

procedure CopyDbDataToExcel(Args: array of const);

var

iCount, jCount: Integer;

XLApp: Variant;

Sheet: Variant;

I: Integer;

begin

Screen.Cursor := crHourGlass;

if not VarIsEmpty(XLApp) then

begin

XLApp.DisplayAlerts := False;

XLApp.Quit;

VarClear(XLApp);

end;

try

XLApp := CreateOleObject('excel.Application');

except

Screen.Cursor := crDefault;

Exit;

end;

XLApp.WorkBooks.Add;

XLApp.SheetsInNewWorkbook := High(Args) + 1;

for I := Low(Args) to High(Args) do

begin

XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;

Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];

if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then

begin

Screen.Cursor := crDefault;

Exit;

end;

TDBGrid(Args[I].VObject).DataSource.DataSet.first;

for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do

Sheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;

jCount := 1;

while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do

begin

for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do

Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;

Inc(jCount);

TDBGrid(Args[I].VObject).DataSource.DataSet.Next;

end;

XlApp.Visible := True;

Screen.Cursor := crDefault;

end;

procedure TForm1.BitBtn3Click(Sender: TObject);//导出操作

begin

CopyDbDataToExcel([DBGrid4]);

end;

我想解决问题有两种办法：一、直接修改CopyDbDataToExcel。二、实现dbgrid4显示的字段列与listbox2中字段同步， dbgrid4中的其余字段要删除掉，不是隐藏。也就是用listbox2中字段来控制哪些字段导入到excel表中呀,如何实现呀? 请高手指点!

*****************************

将dbgrid中数据导出到excel后,如何编写程序使excel的列宽调整为最适合的列宽?

ExcelWorkSheet1.Columns.AutoFit;

************************************

var

s:string;

i,j:integer;

begin

s:='d:/aa/aa.xls'; //文件名

if fileexists(s) then deletefile(s);

v:=CreateOLEObject('Excel.Application'); //建立OLE对象

V.WorkBooks.Add;

if Checkbox1.Checked then

begin

V.Visible:=False;

//使Excel可见，并将本程序最小化，以观察Excel的运行情况

end

else

begin

V.Visible:=True; //True

end;

//使Excel窗口不可见

//Application.BringToFront; //程序前置

try

Cursor:=crSQLWait;

query1.DisableControls;

For i:=0 to query1.FieldCount-1 do //字段数

//注意：Delphi中的数组的下标是从0开始的，

// 而Excel的表格是从1开始编号

begin

V.Goto('R1'+'C'+IntToStr(i+1)); //Excel的表格是从1开始编号

V.ActiveCell.FormulaR1C1:=query1.Fields[i].FieldName;//传送字段名

end;

j:=2;

query1.First;

while not query1.EOF do

begin

For i:=0 to query1.FieldCount-1 do //字段数

begin

V.Goto('R'+IntToStr(j)+'C'+IntToStr(i+1));

V.ActiveCell.FormulaR1C1:=query1.Fields[i].AsString;//传送内容

end;

query1.Next;

j:=j+1;

end;

//设置保护

ShowMessage('数据库到Excel的数据传输完毕!');

except //发生错误时

ShowMessage('没有发现Excel!');

end;

finally

Cursor:=crDefault;

query1.First;

query1.EnableControls;

end;

//和上面的差不多，不过不是从DBGrid中导出的！上面的也不是，只是从Query中

导出来。我也想知从DBGrid 中怎么样导出来，或直接打印也行！

************************************************

直接使用Excel对象，它是标准的COM对象，可以在Delphi中引用的。

我给你一个函数：

function ExportDataToExcel(cds: TClientDataSet; dbGrid: TDBGrid; ExcelAppData: TExcelApplication;

Title, strWhere: String): Boolean;

var

sheet,Range: Variant;

i,j: Integer;

str,fVal: String;

begin

Result := False;

if (cds = nil) or (not cds.Active) then Exit;

try

if ExcelAppData.Tag = 1 then

begin

ExcelAppData.Disconnect;

ExcelAppData.Tag := 0;

end;

ExcelAppData.Connect;

ExcelAppData.Visible[0] := True;

ExcelAppData.Tag := 1;

except

ShowMessage('启动Excel失败，Excel可能没有安装。');

Abort;

end;

cds.DisableControls;

try

if Trim(Title) = ' then Title := '查询结果';

ExcelAppData.Caption := Title;

ExcelAppData.Workbooks.Add(emptyparam,0);

sheet := ExcelAppData.Workbooks[ExcelAppData.Workbooks.Count].Worksheets[1];

sheet.name := Title;

i := (dbGrid.Columns.Count div 2) - 1;

if i < 1 then i:=1;

Sheet.Cells[1,i] := Title;

ExcelAppData.StandardFontSize[0] := 9; //设置表格字体

if dbGrid.Columns.Count < 24 then

begin

str := Char(Ord('A') + dbGrid.Columns.Count -1); // 计算最后一列的列标

Range := Sheet.Range['A3:' + str + '3']; //取出表头的边界

Range.Columns.Interior.ColorIndex := 8; //设置表头的颜色

//计算表格区域

str := 'A3:' + str + IntToStr(cds.RecordCount + 3);

Range := Sheet.Range[str]; //取出表格数据区域边界

Range.Borders.LineStyle := xlContinuous; // 设置表格的线条

end;

Sheet.Cells[2,1] := strWhere;//'日期：' + DateToStr(Date);

//写表头

for j := 0 to dbGrid.Columns.Count -1 do

begin

Sheet.Cells[3,j + 1] := dbGrid.Columns.Items[j].Title.Caption;

Sheet.Columns.Columns[j+1].ColumnWidth := dbGrid.Columns.Items[j].Width div 6;

end;

//写表的内容

cds.First;

for i:= 4 to cds.RecordCount + 3 do

begin

for j := 0 to dbGrid.Columns.Count - 1 do

begin

fVal := Trim(cds.FieldByName(dbGrid.Columns.Items[j].FieldName).AsString);

Sheet.Cells[i,j + 1] := fVal;

end;

cds.Next;

end;

Sleep(1000); //延时1秒，等待Excel处理完成

Result := True;

except on E: Exception do

ShowMessage('数据导出时出现异常！' + E.Message);

end;

ExcelAppData.Disconnect;

cds.EnableControls;

end;

上一篇 »vb调用excel方法详解及操作相关操作命令大全
下一篇 »Delphi Excel 操作大全

Delphi Excel 操作大全

相关推荐

Delphi 操作Excel

ASP.NET导入导出Excel方法大全

VB操作EXCEL文件大全

[VB]VB操作Execl大全

C#读取Excel数据操作大全

Windows关机函数ExitWindowsEx使用大全-Delphi，适用Windows所有操作平台

Delphi- 操作EXCEL

Delphi 操作Excel - 滔Roy