澳门新葡萄京官网注册Delphi Excel 操作大全

近来一段时间忙的慌,接了个帮人升级系统的小单子。其中涉及到将DbGrid的数据转到Excel文件并保存的功能,其实本身倒也不难。只是有些麻烦。想想这种功能,肯定有先人已经写好的现成东西直接拿过来用就应该OK了。于是Google一番,果然有很多类似的例子代码,俺在盒子上找到了和俺的需求相近的一个代码DbGrid2Excel这个代码。他那个写的确实不错,但是有些地方也还是不能尽如人意的哈,于是就在他的代码上修改了下,同时新增加了进度提示的窗口,导出时能随时取消的功能。分页方面不再固定死了,而是由用户规定一个表中最多能存放多少条数据。同时增加表名称的设置。呵呵,废话也不多说,直接贴代码吧

一;

(一) 使用动态创建的方法
首先创建 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,
   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;
本人 收藏

DelphiCode: (*原作者: iamdream(delphi盒子)
修改: 不得闲
功能: 将DbGrid数据保存到Excel
参数:
Grid指定表格
FileName指定要保存的文件名
MaxPageRowCount指定一页最多的支持行数
ShowProgress 指定是否显示进度条
用法:
SaveDbGridAsExcel(DBGrid1,’C:2.xls’,’表测试’,2000,’,’,’);
*)

delphi 快速导出excel

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

procedure SaveDbGridAsExcel(Grid: TDBGrid;const FileName,title:
string;
const MaxPageRowCount: Integer = 65535;const ShowProgress: Boolean =
True,’,’,’);
const
MAX_VAR_ONCE = 1000; //一次导出的条数
var //返回导出记录条数
Excel, varCells: Variant;
MySheet, MyCells, Cell1, Cell2, Range: OleVariant;
iRow, iCol, iSheetIdx, iVarCount, iCurRow: integer;
CurPos: TBookmark;
ProgressForm: TForm;
Prompt: TLabel;
progressBar: TProgressBar;
Panel : TPanel;
Button : TButton;
procedure ReSetObjEvent(OldEventAddr: pointer;NewEventValue:
pointer;ReSetObject: TObject,’,’,’);
begin
TMethod(OldEventAddr^).Code := NewEventValue;
TMethod(OldEventAddr^).Data := ReSetObject;
end;

uses ComObj,clipbrd;

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

procedure ButtonClick(BtnObject: TObject;Sender: TObject,’,’,’);
begin
TComponent(BtnObject).Tag := Integer(MessageBox(Application.Handle,
‘真的要终止数据的导出吗?’,’确认’,
MB_OKCANCEL + MB_ICONINFORMATION) = IDOK,’,’,’);
end;

function ToExcel(sfilename:string; ADOQuery:TADOQuery):boolean;

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

procedure CreateProgressForm;
begin
ProgressForm := TForm.Create(nil,’,’,’);
With ProgressForm do
begin
Font.Name := ‘宋体’;
Font.Size := 10;
BorderStyle := bsNone;
Width := 280;
Height := 120;
BorderWidth := 1;
Color := clBackground;
Position := poOwnerFormCenter;
end;
Panel := TPanel.Create(ProgressForm,’,’,’);
with Panel do { Create Panel }
begin
Parent := ProgressForm;
Align := alClient;
BevelInner := bvNone;
BevelOuter := bvNone;
Caption := ”;
end;

const


Prompt := TLabel.Create(Panel,’,’,’);
with Prompt do { Create Label }
begin
Parent := Panel;
Left := 20;
Top := 25;
Caption := ‘正在启动Excel,请稍候……’;
end;

xlNormal=-4143;

 

progressBar := TProgressBar.Create(panel,’,’,’);
with ProgressBar do { Create ProgressBar }
begin
Step := 1;
Parent := Panel;
Smooth := true;
Left := 20;
Top := 50;
Height := 18;
Width := 260;
end;

var

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;

Button := TButton.Create(Panel,’,’,’);
with Button do { Create Cancel Button }
begin
Parent := Panel;
Left := 115;
Top := 80;
Caption := ‘关闭’;
end;
ReSetObjEvent(@@Button.OnClick,@ButtonClick,Button,’,’,’);
ProgressForm.FormStyle := fsStayOnTop;
ProgressForm.Show;
ProgressForm.Update;
end;

y : integer;


begin
if (Grid.DataSource <> nil) and
(Grid.DataSource.DataSet <> nil) and
Grid.DataSource.DataSet.Active then
begin
Grid.DataSource.DataSet.DisableControls;
CurPos := Grid.DataSource.DataSet.GetBookmark;
Grid.DataSource.DataSet.First;
try
if ShowProgress then
begin
CreateProgressForm;
Button.Tag := 0;
end;
Excel := CreateOleObject(‘Excel.Application’,’,’,’);
Excel.WorkBooks.Add;
Excel.Visible := False;
except
Application.Messagebox(‘Excel 没有安装!’,’操作提示’, MB_IConERROR +
mb_Ok,’,’,’);
Screen.Cursor := crDefault;
Grid.DataSource.DataSet.GotoBookmark(CurPos,’,’,’);
Grid.DataSource.DataSet.FreeBookmark(CurPos,’,’,’);
Grid.DataSource.DataSet.EnableControls;
if ProgressForm <> nil then
ProgressForm.Free;
exit;
end;
if Grid.DataSource.DataSet.RecordCount <= MAX_VAR_ONCE then
iVarCount := Grid.DataSource.DataSet.RecordCount
else iVarCount := MAX_VAR_ONCE;
varCells := VarArrayCreate([1,
iVarCount,1,Grid.FieldCount],varVariant,’,’,’);

tsList : TStringList;

 

iSheetIdx := 1;
iRow := 0;
if ShowProgress then
begin
ProgressBar.Position := 0;
Prompt.Caption := ‘请等待,正在导出数据……’;
ProgressBar.Max := Grid.DataSource.DataSet.RecordCount;
end;
while (not Grid.DataSource.DataSet.Eof and not ShowProgress) or
(not Grid.DataSource.DataSet.Eof and ShowProgress and (Button.Tag = 0))
do
begin
if (iRow = 0) or (iRow > MaxPageRowCount + 1) then
begin
if iSheetIdx <= Excel.WorkBooks[1].WorkSheets.Count then
MySheet := Excel.WorkBooks[1].WorkSheets[iSheetIdx]
else
MySheet := Excel.WorkBooks[1].WorkSheets.Add(NULL,
MySheet,’,’,’);//加在后面
MySheet.Name := Title + IntToStr(iSheetIdx,’,’,’);
MyCells := MySheet.Cells;
Inc(iSheetIdx,’,’,’);
//开始新的数据表
iRow := 1;
//写入表头
for iCol := 1 to Grid.FieldCount do
begin
MySheet.Cells[1, iCol] := Grid.Columns[iCol-1].Title.Caption;
MySheet.Cells[1, iCol].Font.Bold := True;
if (Grid.Fields[iCol – 1].DataType = ftString) or
(Grid.Fields[iCol – 1].DataType = ftWideString) then
//对于“字符串”型数据则设Excel单元格为“文本”型
MySheet.Columns[iCol].NumberFormatLocal := ‘@’;
end;
Inc(iRow,’,’,’);
end;
iCurRow := 1;
while (not Grid.DataSource.DataSet.Eof and not ShowProgress) or
(not Grid.DataSource.DataSet.Eof and ShowProgress and (Button.Tag = 0))
do
begin
for iCol := 1 to Grid.FieldCount do
begin
Application.ProcessMessages;
if Grid.Fields[iCol – 1].IsBlob then
varCells[iCurRow, iCol] := ‘二进制数据’
else varCells[iCurRow, iCol] := Grid.Fields[iCol-1].AsString;
end;
Inc(iRow,’,’,’);
Inc(iCurRow,’,’,’);
if ShowProgress then
ProgressBar.Position := ProgressBar.Position + 1;
Application.ProcessMessages;
Grid.DataSource.DataSet.Next;
if (iCurRow > iVarCount) or (iRow > MaxPageRowCount + 1) then
begin
Application.ProcessMessages;
Break;
end;
end;
Cell1 := MyCells.Item[iRow – iCurRow + 1, 1];
Cell2 := MyCells.Item[iRow – 1,Grid.FieldCount];
Range := MySheet.Range[Cell1 ,Cell2];
Range.Value := varCells;
MySheet.Columns.AutoFit;
Cell1 := Unassigned;
Cell2 := Unassigned;
Range := Unassigned;
Application.ProcessMessages;
end;
if (ShowProgress and (Button.Tag = 0)) or not ShowProgress then
MySheet.saveas(FileName,’,’,’);
MyCells := Unassigned;
varCells := Unassigned;
Excel.WorkBooks[1].Saved := True;
MySheet.application.quit;
Excel.quit;
Excel := Unassigned;
if CurPos <> nil then
begin
Grid.DataSource.DataSet.GotoBookmark(CurPos,’,’,’);
Grid.DataSource.DataSet.FreeBookmark(CurPos,’,’,’);
end;
Grid.DataSource.DataSet.EnableControls;
if ProgressForm <> nil then
ProgressForm.Free;
end;
end;

s,filename :string;

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;

本文来自CSDN博客,转载请标明出处:

aSheet :Variant;

  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;

excel :OleVariant;

 

savedialog :tsavedialog;

看看我的函数
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

begin

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

Result := true;

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

try

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

excel:=CreateOleObject(‘Excel.Application’);

      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;

excel.workbooks.add;

 

except

 

//screen.cursor:=crDefault;

转别人的组件
unit OleExcel;

showmessage(‘无法调用Excel!’);

interface

exit;

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

end;

    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;

savedialog:=tsavedialog.Create(nil);

procedure Register;

savedialog.FileName:=sfilename; //存入文件

implementation

savedialog.Filter:=’Excel文件(*.xls)|*.xls’;

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

if savedialog.Execute then

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

begin

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;

if FileExists(savedialog.FileName) then

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;

try

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

if
application.messagebox(‘该文件已经存在,要覆盖吗?’,’询问’,mb_yesno+mb_iconquestion)=idyes
then

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

DeleteFile(PChar(savedialog.FileName))

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;

else

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

begin

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;

Excel.Quit;

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

savedialog.free;

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

//screen.cursor:=crDefault;

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

Exit;

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

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;

except

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

Excel.Quit;

  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;

savedialog.free;

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;

screen.cursor:=crDefault;

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

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;

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;

filename:=savedialog.FileName;

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;

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;

savedialog.free;

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;

if filename=” then

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

begin

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

result:=true;

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;
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
    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.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 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;
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;
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;
    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;
      end;
      Inc(i);
      Next;
    end;
  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;
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;  
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;
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;
 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;
  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
  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;
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;

Excel.Quit;

//screen.cursor:=crDefault;

exit;

end;

aSheet:=excel.Worksheets.Item[1];

tsList:=TStringList.Create;

//tsList.Add(‘查询结果’); //加入标题

s:=”; //加入字段名

for y := 0 to adoquery.fieldCount – 1 do

begin

s:=s+adoQuery.Fields.Fields[y].FieldName+#9 ;

Application.ProcessMessages;

end;

tsList.Add(s);

try

try

ADOQuery.First;

While Not ADOQuery.Eof do

begin

s:=”;

for y:=0 to ADOQuery.FieldCount-1 do

begin

s:=s+ADOQuery.Fields[y].AsString+#9;

Application.ProcessMessages;

end;

tsList.Add(s);

ADOQuery.next;

end;

Clipboard.AsText:=tsList.Text;

except

result:=false;

end;

finally

tsList.Free;

end;

aSheet.Paste;

MessageBox(Application.Handle,’数据导出完毕!’,’系统提示’,MB_ICONINFORMATION
or MB_OK);

try

if copy(FileName,length(FileName)-3,4)<>’.xls’ then

FileName:=FileName+’.xls’;

Excel.ActiveWorkbook.SaveAs(FileName, xlNormal, ”, ”, False, False);

except

Excel.Quit;

screen.cursor:=crDefault;

exit;

end;

Excel.Visible := false; //true会自动打开已经保存的excel

Excel.Quit;

Excel := UnAssigned;

 

end;

调用:

ToExcel(‘D:a.xsl’,QueryToExcel);//路径可以自定义


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

二;

delphi如何导出EXCEL,代码。非第3方控件

首先在Uses处加上ComObj

procedure TForm1.Button1Click(Sender: TObject);

var h,k:integer;

Excelid: OleVariant;

s: string;

begin

try

Excelid := CreateOLEObject(‘Excel.Application’);

except

Application.MessageBox(‘Excel没有安装!’, ‘提示信息’,
MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);

Exit;

end;

try

ADOQuery1.Close;

ADOQuery1.SQL.Clear;

ADOQuery1.SQL.Add(‘select * from jj_department’);

ADOQuery1.Open;

k:=ADOQuery1.RecordCount;

Excelid.Visible := True;

Excelid.WorkBooks.Add;

Excelid.worksheets[1].range[‘A1:c1’].Merge(True);

Excelid.WorkSheets[1].Cells[1,1].Value :=’部门编码表’ ;

Excelid.worksheets[1].Range[‘a1:a1’].HorizontalAlignment :=
$FFFFEFF4;

Excelid.worksheets[1].Range[‘a1:a1’].VerticalAlignment := $FFFFEFF4;

Excelid.WorkSheets[1].Cells[2,1].Value := ‘组别编号’;

Excelid.WorkSheets[1].Cells[2,2].Value := ‘公司编号’;

Excelid.WorkSheets[1].Cells[2,3].Value := ‘组别名称’;

Excelid.worksheets[1].Range[‘A1:c1’].Font.Name := ‘宋体’;

Excelid.worksheets[1].Range[‘A1:c1’].Font.Size := 9;

Excelid.worksheets[1].range[‘A1:c2’].font.bold:=true;

Excelid.worksheets[1].Range[‘A2:c2’].Font.Size := 9;

Excelid.worksheets[1].Range[‘A2:c2’].HorizontalAlignment :=
$FFFFEFF4;

Excelid.worksheets[1].Range[‘A2:c2’].VerticalAlignment := $FFFFEFF4;

h:=3;

ADOQuery1.First;

while not ADOQuery1.Eof do

begin Excelid.WorkSheets[1].Cells[h,1].Value :=
Adoquery1.FieldByName(‘Fdept_id’).AsString;

Excelid.WorkSheets[1].Cells[h,2].Value :=
Adoquery1.FieldByName(‘Ffdept_id’).AsString;

Excelid.WorkSheets[1].Cells[h,3].Value :=
Adoquery1.FieldByName(‘Fdept_name’).AsString;

Inc(h);

Adoquery1.Next;

end;

s := ‘A2:f’+ IntToStr(k+2);

Excelid.worksheets[1].Range[s].Font.Name := ‘宋体’;

Excelid.worksheets[1].Range[s].Font.size := 9;

Excelid.worksheets[1].Range[s].Borders.LineStyle := 1;

Excelid.Quit;

except

Application.MessageBox(‘导入数据出错!请检查文件的格式是否正确!’,
‘提示信息’, MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);

end;

MessageBox(GetActiveWindow(), ‘EXCEL数据导出成功!’, ‘提示信息’, MB_OK
+MB_ICONWARNING);

end;

 


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

三;

delphi导出EXCEL

uses

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

Dialogs, ExtCtrls, Mask, ComCtrls, StdCtrls, Buttons, Grids, ValEdit,
IdBaseComponent,

CheckLst, excel97, ExcelXP, OleServer, ComObj, excel2000, mmsystem,
ShellAPI,

ADODB, DB, DBGrids, clipbrd;

Var

FExcel:OleVariant; //excel应用程序

FWorkBook :OleVariant; //工作表

Temsheet:OleVariant; //工作薄

FPicture:OleVariant;//图片

tmpstr:String;

range:variant;//范围

i,j,TemInt:integer;

TemFileName:String;

begin

SaveDialog1.Filter:=’.xls’;

if SaveDialog1.Execute then

begin

TemFileName:=SaveDialog1.FileName+’.xls’;

 

Screen.Cursor:=CrHourGlass;

TemInt:=0;

FExcel:= CreateoleObject(‘excel.Application’);

FWorkBook:=FExcel.WorkBooks.Add(-4167); //新的工作表

Temsheet:=FWorkBook.Worksheets.Add;

Temsheet.Name:=’利润统计’;

Temsheet.Select;

Temsheet.Columns[1].ColumnWidth:=4;//设置列宽度

Temsheet.Columns[2].ColumnWidth:=10;

Temsheet.Columns[3].ColumnWidth:=16;

Temsheet.Columns[4].ColumnWidth:=10;

Temsheet.Columns[5].ColumnWidth:=10;

Temsheet.Columns[6].ColumnWidth:=10;

Temsheet.Columns[7].ColumnWidth:=10;

Temsheet.Columns[8].ColumnWidth:=10;

Temsheet.Columns[9].ColumnWidth:=20;

Temsheet.Columns[10].ColumnWidth:=15;

range:=Temsheet.Range[Temsheet.cells[1,1],Temsheet.cells[5,2]];//选定表格

range.select;

range.merge; //合并单元格

tmpstr:=ExtractFilePath(ParamStr(0))+’tem.jpg’; //添加图片

FPicture:=Temsheet.Pictures.Insert(tmpstr);

FPicture.Left:=20;

FPicture.Top:=5;

FPicture.width:=50;

FPicture.height:=50;

FPicture:=null;

range:=Temsheet.Range[Temsheet.cells[2,3],Temsheet.cells[3,4]];//选定表格

range.select;

range.merge;

Range.Characters.Font.FontStyle :=’加粗’;

Temsheet.Cells[2,3].HorizontalAlignment:=-4108; //字居中

Temsheet.Cells[2,3]:=ComSName;

range:=Temsheet.Range[Temsheet.cells[4,3],Temsheet.cells[4,4]];//选定表格

range.select;

range.merge;

Temsheet.Cells[4,3].HorizontalAlignment:=-4108; //字居中

Temsheet.Cells[4,3]:=ComEName;

range:=Temsheet.Range[Temsheet.cells[2,5],Temsheet.cells[2,6]];//选定表格

range.select;

range.merge;

Temsheet.Cells[2,5].HorizontalAlignment:=-4108; //字居中

Temsheet.Cells[2,5]:=ComName;

Temsheet.Cells[3,5]:=’联系人:’;

Temsheet.Cells[4,5]:=’电话:’;

Temsheet.Cells[4,6]:=ComPhone;

Temsheet.Cells[5,5]:=’传真:’;

Temsheet.Cells[5,6]:=ComFax;

range:=Temsheet.Range[Temsheet.cells[6,1],Temsheet.cells[6,10]];//选定表格

range.select;

range.merge;

range:=Temsheet.Range[Temsheet.cells[7,1],Temsheet.cells[7,2]];//选定表格

range.select;

range.merge;

Range.Characters.Font.FontStyle :=’加粗’;

Temsheet.Cells[7,1]:=’入库信息:’;

range:=Temsheet.Range[Temsheet.cells[7,3],Temsheet.cells[7,10]];//选定表格

range.select;

range.merge;

Temsheet.Cells[8,1]:=’序号’;

Temsheet.Cells[8,1].HorizontalAlignment:=-4108; //字居中

Temsheet.Cells[8,1].Interior.Color:=clGray; //单元格背景色

range:=Temsheet.Range[Temsheet.cells[8,1],Temsheet.cells[8,1]];//选定表格

range.borders.linestyle:=1;//华线

for i:=0 to DBGrid1.Columns.Count – 1 do

begin

Temsheet.Cells[8,i+2]:=DBGrid1.Columns[i].Title.Caption;

Temsheet.Cells[8,i+2].HorizontalAlignment:=-4108; //字居中

Temsheet.Cells[8,i+2].Interior.Color:=clGray; //单元格背景色

range:=Temsheet.Range[Temsheet.cells[8,i+2],Temsheet.cells[8,i+2]];//选定表格

range.borders.linestyle:=1;//华线

end;

//////////////////////////////////////////////

j:=0;

DBGrid1.DataSource.DataSet.First;

while not DBGrid1.DataSource.DataSet.Eof do

begin

Temsheet.Cells[9+j,1].Value:=j+1;

Temsheet.Cells[9+j,1].HorizontalAlignment:=-4108; //字居中

range:=Temsheet.Range[Temsheet.cells[9+j,1],Temsheet.cells[9+j,1]];//选定表格

range.borders.linestyle:=1;//华线

for i:=0 to DBGrid1.Columns.Count – 1 do

begin

Temsheet.Cells[9+j,i+2].Value:=DBGrid1.Fields[i].AsString;

range:=Temsheet.Range[Temsheet.cells[9+j,i+2],Temsheet.cells[9+j,i+2]];//选定表格

range.borders.linestyle:=1;//华线

end;

DBGrid1.DataSource.DataSet.Next;

j:=j+1;

end;

TemInt:=9+ DBGrid1.DataSource.DataSet.RecordCount;

range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,10]];//选定表格

range.select;

range.merge;

TemInt:=TemInt+1;

range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格

range.select;

range.merge;

Range.Characters.Font.FontStyle :=’加粗’;

Temsheet.Cells[TemInt,1]:=’出库信息:’;

 

range:=Temsheet.Range[Temsheet.cells[TemInt,3],Temsheet.cells[TemInt,10]];//选定表格

range.select;

range.merge;

TemInt:=TemInt+1;

Temsheet.Cells[TemInt,1]:=’序号’;

Temsheet.Cells[TemInt,1].HorizontalAlignment:=-4108; //字居中

Temsheet.Cells[TemInt,1].Interior.Color:=clGray; //单元格背景色

range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,1]];//选定表格

range.borders.linestyle:=1;//华线

for i:=0 to DBGrid2.Columns.Count – 1 do

begin

Temsheet.Cells[TemInt,i+2]:=DBGrid2.Columns[i].Title.Caption;

Temsheet.Cells[TemInt,i+2].HorizontalAlignment:=-4108; //字居中

Temsheet.Cells[TemInt,i+2].Interior.Color:=clGray; //单元格背景色

range:=Temsheet.Range[Temsheet.cells[TemInt,i+2],Temsheet.cells[TemInt,i+2]];//选定表格

range.borders.linestyle:=1;//华线

end;

TemInt:=TemInt+1;

//////////////////////////////////////////////

j:=0;

DBGrid2.DataSource.DataSet.First;

while not DBGrid2.DataSource.DataSet.Eof do

begin

Temsheet.Cells[TemInt+j,1].Value:=j+1;

Temsheet.Cells[TemInt+j,1].HorizontalAlignment:=-4108; //字居中

range:=Temsheet.Range[Temsheet.cells[TemInt+j,1],Temsheet.cells[TemInt+j,1]];//选定表格

range.borders.linestyle:=1;//华线

for i:=0 to DBGrid2.Columns.Count – 1 do

begin

Temsheet.Cells[TemInt+j,i+2].Value:=DBGrid2.Fields[i].AsString;

range:=Temsheet.Range[Temsheet.cells[TemInt+j,i+2],Temsheet.cells[TemInt+j,i+2]];//选定表格

range.borders.linestyle:=1;//华线

end;

DBGrid2.DataSource.DataSet.Next;

j:=j+1;

end;

TemInt:=TemInt+ DBGrid2.DataSource.DataSet.RecordCount;

TemInt:=TemInt+1;

 

range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,10]];//选定表格

range.select;

range.merge;

TemInt:=TemInt+1;

range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格

range.select;

range.merge;

Range.Characters.Font.FontStyle :=’加粗’;

Temsheet.Cells[TemInt,1]:=’入库总额:’;

Temsheet.Cells[TemInt,3]:=Trim(Edit1.Text);

range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//选定表格

range.select;

range.merge;

TemInt:=TemInt+1;

range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格

range.select;

range.merge;

Range.Characters.Font.FontStyle :=’加粗’;

Temsheet.Cells[TemInt,1]:=’出库总额:’;

Temsheet.Cells[TemInt,3]:=Trim(Edit2.Text);

range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//选定表格

range.select;

range.merge;

TemInt:=TemInt+1;

range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//选定表格

range.select;

range.merge;

Range.Characters.Font.FontStyle :=’加粗’;

Temsheet.Cells[TemInt,1]:=’总利润:’;

Temsheet.Cells[TemInt,3]:=Trim(Edit3.Text);

range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//选定表格

range.select;

range.merge;

 

range:=Temsheet.Range[Temsheet.cells[7,1],Temsheet.cells[TemInt,10]];//选定表格

range.borders.linestyle:=1;//华线

Application.ProcessMessages;

Screen.Cursor:=CrDefault;

FExcel.WorkBooks[1].saveas(TemFileName);//保存文件

FExcel.workbooks[1].close; //关闭工作表

Application.ProcessMessages;

MessageBox(Handle,’导出成功’,’提示’,MB_OK);

//FExcel.visible:=true;

FExcel.quit; //关闭Excel

FExcel := unassigned;

shellexecute(0,’open’,PChar(ExtractFileName(TemFileName)),nil,PChar(ExtractFilePath(TemFileName)),SW_Show);

 

end;

end;


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

uses

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

Dialogs, ExtCtrls, Mask, ComCtrls, StdCtrls, Buttons, Grids, ValEdit,
IdBaseComponent,

CheckLst, excel97, ExcelXP, OleServer, comobj, excel2000, mmsystem,

ADODB, DB, DBGrids, clipbrd;

四;

procedure TFIND_FM.Button1Click(Sender: TObject);

var

i,j : integer;

reportname, wpath : string;

ExApp1 : TExcelApplication;

ExWrbk1 : TExcelWorkbook;

ExWrst1 : TExcelWorksheet;

begin

 

if Main_FM.ADOQuery_TEMP.IsEmpty then

begin

Showmessage(‘沒有可導出的資料!’);

Exit;

end

else

begin

Main_FM.SaveDialog1.FileName := ‘qcreport’;

if Main_FM.savedialog1.Execute then

begin

//savedialog1.FileName :=
formatdatetime(‘YYYYMMDDHHMMSS’,now())+’md_orderqc_list.xls’;

reportname :=
formatdatetime(‘YYYYMMDDHHMMSS’,now())+ExtractFileName(Main_FM.savedialog1.FileName);

//reportname := formatdatetime(‘YYYYMMDDHHMMSS’,now())+”;

wpath := ExtractFilePath(Main_FM.savedialog1.FileName);

//showmessage(wpath);

try

ExApp1 := TExcelApplication.Create(application);

ExWrbk1 := TExcelWorkbook.Create(application);

ExWrst1 := TExcelWorksheet.Create(application);

ExApp1.Connect;

except

Showmessage(‘電腦沒裝Excel!無法導出!’);

Abort;

end;

try

try

ExApp1.Workbooks.Add(EmptyParam,0);

ExWrbk1.ConnectTo(ExApp1.Workbooks[1]);

ExWrst1.ConnectTo(ExWrbk1.Worksheets[1] as _worksheet);

Main_FM.ADOQuery_TEMP.First;

for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do

begin

ExWrst1.Cells.Item[1,j+1] :=
Main_FM.ADOQuery_TEMP.Fields[j].DisplayName;

//

end;

for i := 2 to Main_FM.ADOQuery_TEMP.RecordCount+1 do

begin

for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do

begin

ExWrst1.Cells.Item[i,j+1] :=
Main_FM.ADOQuery_TEMP.Fields[j].Value;

end;

Main_FM.ADOQuery_TEMP.Next;

end;

ExWrst1.SaveAs(wpath+reportname);

//ExWrst.SaveAs(formatdatetime(‘YYYYMMDDHHMMSS’,now())+reportname);;

Showmessage(‘數據已成功導出!’);

except

Showmessage(‘導出失敗!’);

abort;

end;

finally

ExApp1.Disconnect;

ExApp1.Quit;

ExApp1.Free;

ExWrbk1.Free;

ExWrst1.Free;

end;

end;

end;

end;


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

delphi导出数据至Excel的三种方法及比较

闲来无事,跑到网上搜集了几种导出DataSet至Excel的几种方法。另外使用GetTickcount函数计算时差,以便比较。(本来使用Timer控件,但是Timer不适合做高精度时间计算)

使用TADOConnect,TADOQuery查询数据。

方法五:

使用TADOQuery +
Varaint方法,循环遍历数据集中数据,直接插入到Excel的WookBook单元。这是初学者最易懂和易接受的方法。

在下面代码中没有仔细注意语法(比如没有使用try..finally结构体),如果需要使用,请注意:

//使用ADO循环方式保存

procedure TForm1.btn_WhileClick(Sender: TObject);

var

Eclapp:variant;

n:integer;

filename: string;

t1,t2: Int64;

begin

Eclapp := CreateOleObject(‘Excel.Application’);

Eclapp.WorkBooks.Add;

Eclapp.Visible:= False;

filename :=’d:数据1.xls’;

lbl2.Caption := ‘0’;

if FileExists(fileName) then

DeleteFile(fileName);

t1:= GetTickCount;

qry1.DisableControls;

qry1.First;

n:=2;

while not qry1.Eof do

begin

eclapp.cells[n,1] := qry1.Fields[0].AsString;

eclapp.cells[n,2] := qry1.Fields[1].AsString;

eclapp.cells[n,3] := qry1.Fields[2].AsString;

eclapp.cells[n,4] := qry1.Fields[3].AsString;

//为了简单,只添加了4个栏位

inc(n);

qry1.Next;

application.ProcessMessages;

end;

qry1.EnableControls;

t2:= GetTickCount;

eclapp.visible := false;

eclapp.Workbooks[1].SaveAs(filename);

Eclapp.Quit;

Eclapp:= Unassigned;

lbl2.Caption := IntToStr(t2 – t1);

end;


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

方法六:使用OLE方法导入。

先讲TDateSet中的数据保存为二维OLEVariant数组中,再保存到Excel Sheet中
///使用OLE方式保存procedure TForm1.btn_OleVariantClick(Sender:
TObject);

var

fileName: string;

xlApp, Sheet: OleVariant;

rowCount, Colcount, index: Integer;

t1,t2: Int64;

function RefToCell(RowID, ColID: Integer): string;

var

ACount, APos: Integer;

begin

ACount := ColID div 26;

APos := ColID mod 26;

if APos = 0 then

begin

ACount := ACount – 1;

APos := 26;

end;

if ACount = 0 then

Result := Chr(Ord(‘A’) + ColID – 1) + IntToStr(RowID);

if ACount = 1 then

Result := ‘A’ + Chr(Ord(‘A’) + APos – 1) + IntToStr(RowID);

if ACount > 1 then

Result := Chr(Ord(‘A’) + ACount – 1) + Chr(Ord(‘A’) + APos – 1) +
IntToStr(RowID);

end;

function getData(ds: TDataSet): OleVariant;

var

Data: OLEVariant;

i,j : Integer;

begin

rowCount := ds.RecordCount;

colCount := ds.FieldCount;

Data := VarArrayCreate([1, rowCount + 1, 1, colCount], varVariant);
//1,rowCount 表示第一维数组的上下标,1,colCount表示第二维数组的上下标

i := 1;

for j := 0 to colCount – 1 do

begin

if not ds.Fields[j].Visible then

continue;

Data[i,j + 1] := ds.Fields[j].DisplayLabel;

end;

Inc(i);

ds.DisableControls;

try

ds.First;

while not ds.Eof do

begin

for j := 0 to colCount – 1 do

begin

Data[i,j + 1] := ds.Fields[j].AsString;

end;

Inc(i);

ds.Next;

Application.ProcessMessages;

end;

finally

ds.EnableControls;

end;

result := Data;

end;

begin

fileName := ‘d:数据.xls’;

lbl1.Caption := ‘0’;

t1:= GetTickCount;//开始计时

if FileExists(fileName) then

DeleteFile(fileName);

xlApp := CreateOleObject(‘Excel.Application’);

try

XLApp.Visible := False;

XLApp.DisplayAlerts := False;

XLApp.Workbooks.Add;

// 删除多余的 worksheet

for index := XLApp.SheetsInNewWorkbook downto 2 do

begin

XLApp.Workbooks[1].Worksheets[index].Delete;

end;

Sheet := XLApp.Workbooks[1].Worksheets[1];

index := 1;

if index <> 0 then

Sheet := XLApp.Workbooks[1].Worksheets.Add;

Sheet.Name := qry1.Name;

//Sheet.Columns.NumberFormatLocal := ‘@’; //设置单元格式为文本

Sheet.Range[RefToCell(1, 1), RefToCell(rowCount + 1, colCount)].Value
:= getData(qry1);

XLApp.Workbooks[1].SaveAs(fileName);

finally

if not VarIsEmpty(XLApp) then

begin

XLApp.Quit;

XLAPP := Unassigned;

Sheet := Unassigned;

application.ProcessMessages;

t2:= GetTickCount;

lbl1.Caption := IntToStr( t2 – t1);

end;

end;

end;


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

方法七:现在最流行的文件流方法

…..

var

Form1: TForm1;

arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);

arXlsEnd: array[0..1] of Word = ($0A, 00);

arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);

arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);

arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);

arXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);

Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean;
aDataSet: TDataSet);

implementation

{$R *.dfm}

//使用文件流

procedure incColRow; //增加行列号

begin

if Col = ADataSet.FieldCount – 1 then

begin

Inc(Row);

Col :=0;

end

else

Inc(Col);

end;

procedure WriteStringCell(AValue: string);//写字符串数据

var

L: Word;

begin

L := Length(AValue);

arXlsString[1] := 8 + L;

arXlsString[2] := Row;

arXlsString[3] := Col;

arXlsString[5] := L;

aFileStream.WriteBuffer(arXlsString, SizeOf (arXlsString));

aFileStream.WriteBuffer(Pointer(AValue)^, L);

IncColRow;

end;

procedure WriteIntegerCell(AValue: integer);//写整数

var

V: Integer;

begin

arXlsInteger[2] := Row;

arXlsInteger[3] := Col;

aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));

V := (AValue shl 2) or 2;

aFileStream.WriteBuffer(V, 4);

IncColRow;

end;

procedure WriteFloatCell(AValue: double );//写浮点数

begin

arXlsNumber[2] := Row;

arXlsNumber[3] := Col;

aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));

aFileStream.WriteBuffer(AValue, 8);

IncColRow;

end;

Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean;
aDataSet: TDataSet);

var

i,j: integer;

Col , row: word;

ABookMark: TBookMark;

aFileStream: TFileStream;

//……

//……

begin

if FileExists(FileName) then DeleteFile(FileName); //文件存在,先删除

aFileStream := TFileStream.Create(FileName, fmCreate);

Try //写文件头 

aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin)); //写列头  

Col := 0; Row := 0;

if bWriteTitle then

begin

for i := 0 to aDataSet.FieldCount – 1 do

WriteStringCell(aDataSet.Fields[i].FieldName);

end; //写数据集中的数据   

aDataSet.DisableControls;

//ABookMark := aDataSet.GetBookmark;

aDataSet.First ;

while not aDataSet.Eof do

begin

for i := 0 to aDataSet.FieldCount – 1 do

case ADataSet.Fields[i].DataType of

ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:

WriteIntegerCell(aDataSet.Fields[i].AsInteger);

ftFloat, ftCurrency, ftBCD:

WriteFloatCell(aDataSet.Fields[i].AsFloat)

else

WriteStringCell(aDataSet.Fields[i].AsString);

end;

aDataSet.Next;

Application.ProcessMessages;

end;

//写文件尾  

AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));

//if ADataSet.BookmarkValid(ABookMark) then
aDataSet.GotoBookmark(ABookMark);

Finally

AFileStream.Free;

ADataSet.EnableControls;

end;

end;

//调用:

procedure TForm1.btn_FileStreamClick(Sender: TObject);

var

t1,t2: Int64;

begin

lbl3.Caption := ‘0’;

t1:= GetTickCount;

ExportExcelFile(‘d:数据2.xls’,true,qry1);

t2:= GetTickCount;

lbl3.Caption:= IntToStr(t2 – t1);

end;

 

发表评论

电子邮件地址不会被公开。 必填项已用*标注