adoQryToExcell

最新推荐文章于 2024-09-13 16:52:34 发布

Steven_xg

最新推荐文章于 2024-09-13 16:52:34 发布

阅读量501

点赞数

分类专栏： Delphi技术精华文章标签： excel integer string

本文链接：https://blog.csdn.net/Steven_xg/article/details/2305289

版权

Delphi技术精华专栏收录该内容

14 篇文章 0 订阅

订阅专栏

procedure TDataModule1.adoQryToExcell(ADOQuery1: TADOQuery;RptName,TiTle1,TiTle2,TiTle3: string);
var
   i,j,k:integer;
   EParam:OleVariant;
   DocuType:Olevariant;
   wkbk:_WorkBook;
   FileName:OleVariant;
begin
if not ADOQuery1.Active then exit;
if not DirectoryExists(ExtractFilePath(paramstr(0))+'导出文件') then
    if not CreateDir(ExtractFilePath(paramstr(0))+'导出文件') then
    begin
      raise Exception.Create('不能建立文件夹：导出文件！');
      exit;
    end;

   Try
     EA.Connect;
   Except
     ShowMessage('EXCEL文件打开失败!');
     Exit;
   end;

EA.Visible[0]:=false;
EA.Caption:='Excel数据文件';

   EParam:=EmptyParam;
   DocuType:=0;
   try
      wkbk:=EA.Workbooks.Add(EParam,Docutype);
   except
      begin
          EA.Disconnect;
          EA.Quit;
          showmessage('创建EXCEL数据表格失败');
          exit;
      end;
   end;

EWb.ConnectTo(EA.ActiveWorkbook);

EWs.ConnectTo(EWb.Worksheets[1] as _worksheet);

   EWs.Cells.Item[1,1]:=TiTle1 ;
   EWs.Cells.Item[2,1]:=TiTle2;
   EWs.Cells.Item[3,1]:=TiTle3;

     begin
       for I:=1 to ADOQuery1.Fields.Count do
          if ADOQuery1.Fields[I-1].Visible then
            EWs.Cells.Item[4,I]:=ADOQuery1.Fields[I-1].DisplayName;
     end;

   ADOQuery1.First;
   i:=5;
    while not ADOQuery1.Eof do
    BEGIN
       K:=1;
       for j:=1 to ADOQuery1.Fields.Count do
       if ADOQuery1.Fields[j-1].Visible   then
       Begin
         if (ADOQuery1.Fields[J-1].DataType=ftDateTime) then
           EWs.cells.Item[i,K]:=FormatDateTime('yyyy-mm-dd',ADOQuery1.Fields[J-1].AsDateTime)
         else
           EWs.cells.Item[i,K]:= ' ' +Trim(ADOQuery1.Fields[J-1].AsString);
         K:=K+1;
       end;
       ADOQuery1.Next;
       i:=i+1;
    END;

wkbk:=EA.ActiveWorkbook;
DocuType:=0;
FileName:=ExtractFilePath(Application.ExeName);
FileName:=FileName +'导出文件/'+ Trim(RptName)+ '.xls';
wkBk.Close(True,FileName,EmptyParam,DocuType);

EA.Disconnect;
EA.Quit;
ShowMessage('数据导出成功');
end;