从Delphi中导出数据至Excel

最新推荐文章于 2022-05-16 17:57:36 发布

CrystalBeyond

最新推荐文章于 2022-05-16 17:57:36 发布

阅读量826

点赞数 2

分类专栏： Delphi 文章标签： delphi dataset integer excel microsoft function

本文链接：https://blog.csdn.net/CrystalBeyond/article/details/2738722

版权

Delphi 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

unit UntDataSetTOExcel;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ComObj,DB,ADODB;

type
TForm1 = class(TForm)
    btnExport: TButton;
    Adoq: TADOQuery;
    procedure btnExportClick(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
    function DataSetTOExcel(DataSet:TAdoQuery;
                    Visible:Boolean;//Excel程序是否打开
                    FieldTagMax:Integer;
                    ExcelFileName:String=''):Boolean;
    function DataSetToExcelSheet(DataSet:TAdoQuery;
                    FieldTagMax:Integer;
                    Sheet:OleVariant):Boolean;//Sheet为工作表信息
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.DataSetTOExcel(DataSet: TAdoQuery; Visible: Boolean;
FieldTagMax: Integer; ExcelFileName: String): Boolean;
Var
ExcelApp,WorkBook,Sheet:OleVariant;
OldCursor:TCursor;
FileName:String;
SaveDialog:TSaveDialog;
begin
Result:=False;
//如果数据集没有打开，直接退出
if Not(DataSet.Active) then Exit;
//预先操作
OldCursor:=Screen.Cursor;
Screen.Cursor:=crHourGlass;
//调用Excel程序；如果调用失败，弹出提示
try
    ExcelApp:=CreateOleObject('Excel.Sheet');
    //让excel是否可见
    ExcelApp.Application.Visible:=Visible;
    WorkBook:=ExcelApp.Application.WorkBooks.Add;
    Sheet:=WorkBook.Sheets[1];//建立一个sheet对象
except
    ShowMessage('操作失败！'+#13+'很可能由于当前机器中没有安装Exelc！');
    Screen.Cursor:=OldCursor;
    Exit;
end;
//如果不可见，就要保存为文件;
//            如果没有文件名,就要弹出文件保存对话框，
if (Not Visible) and (ExcelFileName='') then
begin
    SaveDialog:=TSaveDialog.Create(Nil);
    SaveDialog.Title:='导出至...';
    SaveDialog.Filter:='Microsoft Excel 工作表(*.xls)|*.xls';
    SaveDialog.DefaultExt:='*.xls';
    SaveDialog.Execute;
    UpdateWindow(GetActiveWindow);
    FileName:=SaveDialog.FileName;
    SaveDialog.Free;
end;
//转换，excel这是否可见
if (Visible Or (FileName<>'')) then
    Result:=DataSetTOExcelSheet(DataSet,FieldTagMax,Sheet);
//如果不可见且转换成功就保存到文件中
if (Not Visible)And(Result) then
begin
    WorkBook.SaveAS(FileName:=FileName);
    WorkBook.Close;
end;
Screen.Cursor:=OldCursor;
end;

function TForm1.DataSetToExcelSheet(DataSet: TAdoQuery;
FieldTagMax: Integer; Sheet: OleVariant): Boolean;
Var
Row,Col,FieldIndex:Integer;
BK:TBookMark;//TBookMark可被认为是记录的标签,在DB单元内
begin
Result:=False;
if Not(DataSet.Active) then
begin
ShowMessage('数据集没有激活！');
Exit;//数据集没打开
end;

BK:=DataSet.GetBookmark;//得到一记录指针
DataSet.DisableControls;//锁定记录
//转换，通过循环，先转标题，后转内容
Sheet.Activate;
Row:=1;
Col:=1;

//表头
for FieldIndex := 0 to DataSet.FieldCount-1 do
begin
    if DataSet.Fields[FieldIndex].tag<=FieldTagMax then
    begin
      Sheet.Cells(Row,Col):=DataSet.Fields[FieldIndex].DisplayLabel;
      Inc(Col);
    end;
end;

//记录信息
DataSet.First;
Try
    while Not(DataSet.Eof) do
    begin
      Inc(Row);
      Col:=1;
      for FieldIndex := 0 to DataSet.FieldCount-1 do
      begin
        if DataSet.Fields[FieldIndex].tag<=FieldTagMax then
        begin
          Sheet.Cells(Row,Col):=DataSet.Fields[FieldIndex].AsString;
          Inc(Col);
        end;
      end;
      DataSet.Next;
    end;
    Result:=True;
    //回到数据集原来的位置，恢复显示空间的同步显示
finally
    DataSet.GotoBookmark(Bk);
    DataSet.EnableControls;
end;
end;