zoukankan      html  css  js  c++  java
  • delphi 快速导出excel

    uses ComObj,clipbrd;

    1 方法:

    function ToExcel(sfilename:string; ADOQuery:TADOQuery):boolean;
    const
    xlNormal=-4143;
    var
    y :integer;
    tsList :TStringList;
    s,filename :string;
    aSheet :Variant;
    excel:OleVariant;
    savedialog:tsavedialog;
    begin
    result:=true;
    try
    excel:=CreateOleObject('Excel.Application');
    excel.workbooks.add;
    except
    //screen.cursor:=crDefault;
    showmessage('无法调用Excel!');
    exit;
    end;
    savedialog:=tsavedialog.Create(nil);
    savedialog.FileName:=sfilename; //存入文件
    savedialog.Filter:='Excel文件(*.xls)|*.xls';
    if savedialog.Execute then
    begin
    if FileExists(savedialog.FileName) then
    try
    if application.messagebox('该文件已经存在,要覆盖吗?','询问',mb_yesno+mb_iconquestion)=idyes then
    DeleteFile(PChar(savedialog.FileName))
    else
    begin
    Excel.Quit;
    savedialog.free;
    //screen.cursor:=crDefault;
    Exit;
    end;
    except
    Excel.Quit;
    savedialog.free;
    screen.cursor:=crDefault;
    Exit;
    end;
    filename:=savedialog.FileName;
    end;
    savedialog.free;
    if filename='' then
    begin
    result:=true;
    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;

    2.调用:

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

  • 相关阅读:
    GoogleTest 之路2-Googletest 入门(Primer)
    GoogleTest 之路1-Generic Build Instructions编译指导总方案
    Tinyhttpd 知识点
    栈初始化
    ARM S3C2440 时钟初始化流程
    GNU 关闭 MMU 和 Icache 和 Dcache
    bootloader 关闭看门狗
    bootloader svc 模式
    Uboot S3C2440 BL1 的流程
    GNU 汇编 协处理器指令
  • 原文地址:https://www.cnblogs.com/martian6125/p/9631126.html
Copyright © 2011-2022 走看看