怎样用DELPHI+SQL把查询到记录导成EXECL

Question

怎样用DELPHI+SQL把查询到记录导成EXECL？？？

Answer 1

procedure TMainForm.CustomItem7Click(Sender: TObject);
Var
  I                                             :Integer;
  ExcelApp,WorkBook                             :Variant;
  d_Progress                                    :Double;
begin
  //数据写入Excel
  Screen.Cursor := crHourGlass;
  ProgressBar1.Position := 0;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := 100;
  with ADOQuery1 do
  begin
    Close;
    SQL.Text := 'Select * from mrm1000';
    Open;
    if RecordCount=0 then
    begin
      ProgressBar1.Position := 100;      messagedlg(#13 + 'No record.',mtinformation,[mbok],0);
      Screen.Cursor := crDefault;
      Exit;
    end
    else
    begin
      ExcelApp:=CreateOleObject('Excel.Application');
      WorkBook:=ExcelApp.WorkBooks.add;
      ExcelApp.ActiveSheet.PageSetup.Orientation := xlLandscape; //
      ExcelApp.ActiveSheet.PageSetup.LeftMargin := 0.4;
      ExcelApp.ActiveSheet.PageSetup.RightMargin := 0.4;//设置页边距
      ExcelApp.Caption:='Employee';
      ExcelApp.ActiveSheet.Columns[1].ColumnWidth:=10;
      ExcelApp.ActiveSheet.Columns[2].ColumnWidth:=10;
      ExcelApp.ActiveSheet.Columns[3].ColumnWidth:=10;
      ExcelApp.ActiveSheet.Columns[4].ColumnWidth:=10;
      ExcelApp.ActiveSheet.Rows[1].Font.Name := 'Times New Roman';
      ExcelApp.Cells[1,3] := 'Employee Report';
      ProgressBar1.Position := 2;
      //ExcelApp.range[ExcelApp.Cells[1,3], ExcelApp.Cells[1,3]].Borders[4].Weight := 2;
      //下划线修改为字体的下划线
      ExcelApp.ActiveSheet.Rows[1].Font.Bold := True;
      ExcelApp.ActiveSheet.Rows[1].Font.UnderLine := True;
      ExcelApp.ActiveSheet.Rows[3].Font.Name := 'Times New Roman';
      ExcelApp.Cells[3,1] := 'created date : ' + FormatDateTime('YYYY-MM-DD',now);
      ProgressBar1.Position := 5;
      ExcelApp.ActiveSheet.Rows[5].Font.Name := 'Times New Roman';
      ExcelApp.range[ExcelApp.Cells[5,1], ExcelApp.Cells[5,4]].Interior.Color := clAqua;
      ExcelApp.Cells[5,1] := 'Employee Code';
      ExcelApp.Cells[5,2] := 'Employee Name';
      ExcelApp.Cells[5,3] := 'Option Pwd';
      ExcelApp.Cells[5,4] := 'Office Code';
      I := 6;
      d_Progress := 92/recordcount;
    end;
    while not eof do
    begin
      ProgressBar1.Position := round(ProgressBar1.Position + d_Progress);
      ExcelApp.Cells[I,1] := FieldByName('user_code').AsString;
      ExcelApp.Cells[I,2] := FieldByName('user_name').AsString;
      ExcelApp.Cells[I,3] := FieldByName('user_pwd').AsString;
      ExcelApp.Cells[I,4] := FieldByName('office_code').AsString;
      Inc(I);
      Next;
    end;
  end;
  ProgressBar1.Position := 98;
  ExcelApp.Cells[I,1] := 'Finished';
  ProgressBar1.Position := 100;
  Screen.Cursor := crDefault;
  ExcelApp.visible:=true;
end;

Answer 2

用QuantumGrid4吧 下载www.2ccc.com
用法：
引用 cxExportGrid4Link
导出Html 
procedure ExportGrid1ToHTML(const AFileName: string; AGrid: TcxGrid; AExpand: Boolean = True; ASaveAll: Boolean = True);导出excel
procedure ExportGrid1ToExcel(const AFileName: string; AGrid: TcxGrid; AExpand: Boolean = True; ASaveAll: Boolean = True; AUseNativeFormat: Boolean = False);导出txt
procedure ExportGrid1ToText(const AFileName: string; AGrid: TcxGrid; AExpand: Boolean = True; ASaveAll: Boolean = True; const ASeparator: string = ''; const ABeginString: string = ''; const AEndString: string = '');

Answer 3

procedure speedtoexcel_user(Sinput:TwwDBGrid);
var
  Ds_Master:Tdataset;
  ExcelApplication1:TExcelApplication;
  ExcelWorksheet1:TExcelWorksheet;
  ExcelWorkbook1:TExcelWorkbook;
  i,j:integer;
  stringlist1:Tstringlist;
  str1:string;
  range1:string;
begin
  Ds_Master:=Sinput.DataSource.DataSet;
  if Ds_Master.IsEmpty or (not Ds_Master.Active) then
     exit
  else
    begin
      Ds_Master.DisableControls;
      Ds_Master.First;
      try
        ExcelApplication1:=TExcelApplication.Create(Application);
        ExcelWorksheet1:=TExcelWorksheet.Create(Application);
        ExcelWorkbook1:=TExcelWorkbook.Create(Application);
        ExcelApplication1.Connect;
      except
        Application.MessageBox('Excel 没有安装','系统提示',
                               MB_IConERROR + mb_Ok);
        Abort;
      end;
    end;  try
    screen.Cursor:=crsqlwait;
    ExcelApplication1.Workbooks.Add(emptyparam,0);
    ExcelWorkbook1.ConnectTo(ExcelApplication1.Workbooks[1]);
    ExcelWorksheet1.ConnectTo(ExcelWorkbook1.Worksheets[1]as _worksheet);
    for j :=0  to Ds_Master.FieldCount-1 do
    begin
      ExcelWorksheet1.Cells.Item[1,j+1]:=Ds_Master.Fields[j].DisplayLabel;
      ExcelWorksheet1.Cells.Item[1,j+1].font.size:='14';
    end;
    stringlist1:=Tstringlist.Create;
    clipboard.Clear;
    with Ds_Master do
    begin
      open;
      first;
    end;
    while not Ds_Master.Eof do
    begin
      str1:='';
      for i := 0 to Ds_Master.FieldCount-1 do
      begin
        str1:=str1+Ds_Master.Fields[i].AsString+#9;
        Application.ProcessMessages;
      end;
      stringlist1.Add(str1);
      Ds_Master.Next;
    end;
    //dataset.Free;
    //dataset.Refresh;
    clipboard.AsText:=stringlist1.Text;
     i:=Ds_Master.FieldCount;
    j:=Ds_Master.RecordCount+1;       //ExcelWorksheet1.Cells.i
    //i:=cells.
    //ExcelWorksheet1.Paste;  //从A1开始粘贴
    //srt1:=ExcelWorksheet1.Cells.Item[i,j];
    //ExcelWorksheet1.Range['a2','z1000'].PasteSpecial(0,0,0,0);
    //ExcelWorksheet1.Range['a2','b4'].PasteSpecial(0,0,0,0);
    //i:=ExcelWorksheet1.Cells.Row[2];
    //j:=ExcelWorksheet1.Cells.Rows.Column;
   //fortest:=string(ExcelWorksheet1.Cells.Name);
    //fortest:=ExcelWorksheet1.Cells.Item[j,i];
    //fortest:=string(ExcelWorksheet1.Cells.Range[i,j] );
    //ExcelWorksheet1.Range['a2'].PasteSpecial(0,0,0,0);
    range1:=excelrange(j,i);
    ExcelWorksheet1.Range['a2',range1].PasteSpecial(0,0,0,0);
    stringlist1.Free;
    clipboard.Clear;
    ExcelWorksheet1.Columns.AutoFit;
    ExcelApplication1.Disconnect;
    ExcelApplication1.Visible[0]:=true;
    screen.Cursor:=crdefault;
    //dataset.Refresh;
    Ds_Master.EnableControls;
    Application.MessageBox('数据转换成功!','系统',
                  MB_ICONINFORMATION+Mb_ok);
                  
  except
    stringlist1.Free;
    clipboard.Clear;
    ExcelApplication1.Disconnect;
    ExcelApplication1.Quit;
    ExcelApplication1.Free;
    ExcelWorkbook1.Free;
    ExcelWorksheet1.Free;
    screen.Cursor:=crdefault;
    Application.MessageBox('错误!','数据转换失败!',
                Mb_iconerror+Mb_ok);
    Ds_Master.EnableControls;
  end;
 end;

Answer 4

QuantumGrid4 这个控件是免费的吗

Answer 5

var Str,Constr:string; i:smallint;
begin
       
       with qrytmp do
        begin
         close;
         sql.Clear;
         sql.Add(' select  NostypeName from __stk_rpt(nolock) group by NosType,NostypeName  order by NosType ');
         open;
         first;
         while not eof do
          begin
           str:=str+chr(9)+fieldbyname('NostypeName').asstring;
           next;
          end;
        end;
        m_1.Lines.Add(str);
        Constr:='';
        with qrystkrpt do
         begin
          first;
          while not eof do
          begin
           str:='';
           for i:= 0 to qrytmp.RecordCount+2 do
            begin
              str:=str+fields[i].Value+chr(9);
            end;
            m_1.Lines.Add(str);
            next;
          end;
         end;
        str:='C:\report\test.txt';
        m_1.Lines.SaveToFile(str);
        WINEXEC(pchar('C:\Program Files\Microsoft Office\Office\Excel.EXE '+ str ),
           SW_SHOWMAXIMIZED);
end;

Answer 6

可以搜索一下相关的帖子，很多的
可以直接使用SQL Server的语句来实现，很简单

Answer 7

用f1book大概就6，7行代码，就可以实现，而且就算机器上没有安装excel同样可以导成excel格式，是真正的excel格式，不是那些用分隔符分隔的文本文件。

Answer 8

用dxdbgrid.
dxdbgrid.savetoxls()

Answer 9

郁闷， 那么麻烦吗？偶有个例子，自己做的，要就留下油箱，或者过两天到DELPHIBOX上下载，偶最近没时间上传，查询导出的部分有的，你可以看下。

Answer 10

我要我的油箱是[email protected]谢谢

Answer 11

to bob008(冻冬)
[email protected]